copyright (C) 2001 MSC-RPN COMM %%%MC2%%%
*
subroutine setpnt2 (dynm0p,dim1,phytend,dim6,dynnes,dim2, 1,5
$ dyndiv,dim3,dyndxdy,dim4,vrtpil)
implicit none
*
logical vrtpil
integer dim1,dim2,dim3,dim4,dim6
real dynm0p (dim1), phytend (dim6), dynnes (dim2), dyndiv (dim3)
real*8 dyndxdy(dim4)
*
#include "dynmem.cdk"
#include "phymem.cdk"
#include "physcom.cdk"
#include "physnml.cdk"
#include "bcsdim.cdk"
#include "bcsmem.cdk"
#include "topo.cdk"
*
integer offset,i,dim,err
*------------------------------------------------------------------
*
offset = 0
pappm = loc(dynm0p(offset+ 1))
pauum = loc(dynm0p(offset+dim2d+1*dim3d+1))
pavvm = loc(dynm0p(offset+dim2d+2*dim3d+1))
pawwm = loc(dynm0p(offset+dim2d+3*dim3d+1))
pabbm = loc(dynm0p(offset+dim2d+4*dim3d+1))
pahum = loc(dynm0p(offset+dim2d+5*dim3d+1))
if(ntr.gt.0) patrm = loc(dynm0p(offset+dim2d+6*dim3d+1))
*
offset = ndynvar*dim3d+dim2d
papp0 = loc(dynm0p(offset+ 1))
pauu0 = loc(dynm0p(offset+dim2d+1*dim3d+1))
pavv0 = loc(dynm0p(offset+dim2d+2*dim3d+1))
paww0 = loc(dynm0p(offset+dim2d+3*dim3d+1))
pabb0 = loc(dynm0p(offset+dim2d+4*dim3d+1))
pahu0 = loc(dynm0p(offset+dim2d+5*dim3d+1))
if(ntr.gt.0) patr0 = loc(dynm0p(offset+dim2d+6*dim3d+1))
*
offset = (ndynvar*dim3d+dim2d)*2
pappp = loc(dynm0p(offset+ 1))
pauup = loc(dynm0p(offset+dim2d+1*dim3d+1))
pavvp = loc(dynm0p(offset+dim2d+2*dim3d+1))
pawwp = loc(dynm0p(offset+dim2d+3*dim3d+1))
pabbp = loc(dynm0p(offset+dim2d+4*dim3d+1))
pahup = loc(dynm0p(offset+dim2d+5*dim3d+1))
if(ntr.gt.0) patrp = loc(dynm0p(offset+dim2d+6*dim3d+1))
*
err = min(0,dim1-(offset+dim2d+6*dim3d+ntr*dim3d))
if (err.lt.0) write(6,101) 'DYNM0P'
call mc2stop(err)
*
dynm0p = 0.
*
dim = bcs_sz/gnk
pbcspp = loc(dynnes( 1))
pbcsuu = loc(dynnes(dim + bcs_sz+1))
pbcsvv = loc(dynnes(dim + 2*bcs_sz+1))
pbcsww = loc(dynnes(dim + 3*bcs_sz+1))
pbcsbb = loc(dynnes(dim + 4*bcs_sz+1))
pbcshu = loc(dynnes(dim + 5*bcs_sz+1))
if(ntr.gt.0) pbcstr = loc(dynnes(dim + 6*bcs_sz+1))
*
offset = dim + (6+ntr)*bcs_sz
pbcsppa = loc(dynnes(offset +1))
pbcsuua = loc(dynnes(offset + dim + bcs_sz+1))
pbcsvva = loc(dynnes(offset + dim + 2*bcs_sz+1))
pbcswwa = loc(dynnes(offset + dim + 3*bcs_sz+1))
pbcsbba = loc(dynnes(offset + dim + 4*bcs_sz+1))
pbcshua = loc(dynnes(offset + dim + 5*bcs_sz+1))
if(ntr.gt.0) pbcstra = loc(dynnes(offset + dim + 6*bcs_sz+1))
offset = offset * 2
*
if (vrtpil) then
papnt = loc(dynnes(offset+ 1))
paunt = loc(dynnes(offset+dim2d+1*dim3d+1))
pavnt = loc(dynnes(offset+dim2d+2*dim3d+1))
pawnt = loc(dynnes(offset+dim2d+3*dim3d+1))
pabnt = loc(dynnes(offset+dim2d+4*dim3d+1))
pahnt = loc(dynnes(offset+dim2d+5*dim3d+1))
if(ntr.gt.0) patnt = loc(dynnes(offset+dim2d+6*dim3d+1))
*
offset = offset + ndynvar*dim3d+dim2d
papna = loc(dynnes(offset+ 1))
pauna = loc(dynnes(offset+dim2d+1*dim3d+1))
pavna = loc(dynnes(offset+dim2d+2*dim3d+1))
pawna = loc(dynnes(offset+dim2d+3*dim3d+1))
pabna = loc(dynnes(offset+dim2d+4*dim3d+1))
pahna = loc(dynnes(offset+dim2d+5*dim3d+1))
if(ntr.gt.0) patna = loc(dynnes(offset+dim2d+6*dim3d+1))
offset = offset + ndynvar*dim3d+dim2d
endif
*
err = min(0,dim2-offset)
if (err.lt.0) write(6,101) 'DYNNES'
call mc2stop(err)
*
offset = 0
pafcor = loc(dyndiv(offset+ 1))
pasmap = loc(dyndiv(offset+1*dim2d+1))
pasbxy = loc(dyndiv(offset+2*dim2d+1))
pasbx = loc(dyndiv(offset+3*dim2d+1))
pasby = loc(dyndiv(offset+4*dim2d+1))
*
offset = (5)*dim2d
pagg1 = loc(dyndiv(offset+ 1))
pagg2 = loc(dyndiv(offset+1*dim3d+1))
pagg0r = loc(dyndiv(offset+2*dim3d+1))
pag0wr = loc(dyndiv(offset+3*dim3d+1))
pag0ur = loc(dyndiv(offset+4*dim3d+1))
pag0vr = loc(dyndiv(offset+5*dim3d+1))
padhdt = loc(dyndiv(offset+6*dim3d+1))
*
offset = (5)*dim2d+(7)*dim3d
pagots = loc(dyndiv(offset+ 1))
paorts = loc(dyndiv(offset+1*dim3d+ 1))
paqstr = loc(dyndiv(offset+2*dim3d+1*dim2d+1))
panssq = loc(dyndiv(offset+3*dim3d+2*dim2d+1))
*
offset = (7)*dim2d+(11)*dim3d
pahw = loc(dyndiv(offset+ 1))
paht = loc(dyndiv(offset+1*dim3d+ 1))
pahm = loc(dyndiv(offset+2*dim3d+ 1))
*
offset = (8)*dim2d+(14)*dim3d
dim = (maxx-minx+2)*(maxy-miny+2)
pahh0 = loc(dyndiv(offset+ 1))
pahh0i = loc(dyndiv(offset+ 2* dim2d +1))
pahh0f = loc(dyndiv(offset+ 2*(dim2d+dim)+1))
*
err = min(0,dim3-(offset+2*(dim2d+dim)+2*dim))
if (err.lt.0) write(6,101) 'DYNDIV'
call mc2stop(err)
*
paodx = loc(dyndxdy( 1))
paodxu = loc(dyndxdy( 2))
paody = loc(dyndxdy( 3))
paodyv = loc(dyndxdy(1*dim2d+3))
palaty = loc(dyndxdy(2*dim2d+3))
palatyv= loc(dyndxdy(3*dim2d+3))
*
err = min(0,dim4-(4*dim2d+3))
if (err.lt.0) write(6,101) 'DYNDXDY'
call mc2stop(err)
*
if (dim6.gt.0) then
offset = 0
pautp1 = loc(phytend(offset+ 1))
pavtp1 = loc(phytend(offset+ dim3d+1))
pattp1 = loc(phytend(offset+2*dim3d+1))
pahutp1= loc(phytend(offset+3*dim3d+1))
offset = 4*dim3d
if (diffuw) then
paswtp1 = loc(phytend(offset+ 1))
offset = offset + dim3d
endif
if (ntrphy.gt.0) then
pacltp1 = loc(phytend(offset+ 1))
offset = offset + ntrphy*dim3d
endif
if (gnpfb.gt.1) then
pautp2 = loc(phytend(offset+ 1))
pavtp2 = loc(phytend(offset+ dim3d+1))
pattp2 = loc(phytend(offset+2*dim3d+1))
pahutp2= loc(phytend(offset+3*dim3d+1))
offset = offset + 4*dim3d
if (diffuw) then
paswtp2 = loc(phytend(offset+ 1))
offset = offset + dim3d
endif
if (ntrphy.gt.0) then
pacltp2 = loc(phytend(offset+ 1))
offset = offset + ntrphy*dim3d
endif
endif
err = min(0,dim6-offset)
if (err.lt.0) write(6,101) 'PHYTEND'
call mc2stop(err)
phytend = 0.
endif
*
101 format (' ERROR WITH DYNAMIC MEM ALLOC IN SETPNT2: ',a)
*------------------------------------------------------------------
return
end