7 kl1, kimax1,kjmax1,px1,py1,pdx1,pdy1, &
8 kxor, kyor, kdxratio, kdyratio, &
10 kl2, kimax2,kjmax2,px2,py2,pdx2,pdy2 )
47 USE yomhook
,ONLY : lhook, dr_hook
48 USE parkind1
,ONLY : jprb
57 INTEGER,
INTENT(IN) :: kluout
58 INTEGER,
INTENT(IN) :: kl1
59 INTEGER,
INTENT(IN) :: kimax1
60 INTEGER,
INTENT(IN) :: kjmax1
61 REAL,
DIMENSION(KL1),
INTENT(IN) :: px1
62 REAL,
DIMENSION(KL1),
INTENT(IN) :: py1
63 REAL,
DIMENSION(KL1),
INTENT(IN) :: pdx1
64 REAL,
DIMENSION(KL1),
INTENT(IN) :: pdy1
65 INTEGER,
INTENT(IN) :: kxor
66 INTEGER,
INTENT(IN) :: kyor
67 INTEGER,
INTENT(IN) :: kxsize
68 INTEGER,
INTENT(IN) :: kysize
69 INTEGER,
INTENT(IN) :: kdxratio
70 INTEGER,
INTENT(IN) :: kdyratio
71 INTEGER,
INTENT(IN) :: kl2
72 INTEGER,
INTENT(IN) :: kimax2
73 INTEGER,
INTENT(IN) :: kjmax2
74 REAL,
DIMENSION(KL2),
INTENT(OUT) :: px2
75 REAL,
DIMENSION(KL2),
INTENT(OUT) :: py2
76 REAL,
DIMENSION(KL2),
INTENT(OUT) :: pdx2
77 REAL,
DIMENSION(KL2),
INTENT(OUT) :: pdy2
84 REAL,
DIMENSION(:),
ALLOCATABLE :: zxm1
85 REAL,
DIMENSION(:),
ALLOCATABLE :: zym1
86 REAL,
DIMENSION(:),
ALLOCATABLE :: zxhat1
87 REAL,
DIMENSION(:),
ALLOCATABLE :: zyhat1
91 REAL,
DIMENSION(:),
ALLOCATABLE :: zxhat2
92 REAL,
DIMENSION(:),
ALLOCATABLE :: zyhat2
98 INTEGER :: jibox,jjbox
100 REAL(KIND=JPRB) :: zhook_handle
109 IF (lhook) CALL dr_hook(
'REGULAR_GRID_SPAWN',0,zhook_handle)
110 IF ( kxor+kxsize-1 > kimax1 )
THEN
111 WRITE(kluout,*)
'spawned domain is not contained in the input domain'
112 WRITE(kluout,*)
'IXOR = ', kxor,
' IXSIZE = ', kxsize,&
113 ' with NIMAX(file) = ', kimax1
114 CALL
abor1_sfx(
'REGULAR_GRID_SPAWN: (1) SPAWNED DOMAIN NOT CONTAINED IN INPUT DOMAIN')
116 IF ( kyor+kysize-1 > kjmax1 )
THEN
117 WRITE(kluout,*)
'spawned domain is not contained in the input domain'
118 WRITE(kluout,*)
'IYOR = ', kyor,
' IYSIZE = ', kysize,&
119 ' with NJMAX(file) = ', kjmax1
120 CALL
abor1_sfx(
'REGULAR_GRID_SPAWN: (2) SPAWNED DOMAIN NOT CONTAINED IN INPUT DOMAIN')
128 ALLOCATE(zxm1(kimax1))
129 ALLOCATE(zym1(kjmax1))
130 ALLOCATE(zxhat1(kimax1+1))
131 ALLOCATE(zyhat1(kjmax1+1))
132 ALLOCATE(zxhat2(kimax2+1))
133 ALLOCATE(zyhat2(kjmax2+1))
135 zxm1(:) = px1(1:kimax1)
137 IF (mod(jl,kimax1)==0) zym1(jl/kimax1) = py1(jl)
147 zxhat1(1) = zxm1(1) - 0.5 * pdx1(1)
148 zxhat1(2) = zxm1(1) + 0.5 * pdx1(1)
150 zxhat1(1) = 1.5 * zxm1(1) - 0.5 * zxm1(2)
152 zxhat1(ji) = 0.5 * zxm1(ji-1) + 0.5 * zxm1(ji)
154 zxhat1(kimax1+1) = 1.5 * zxm1(kimax1) - 0.5 * zxm1(kimax1-1)
158 zyhat1(1) = zym1(1) - 0.5 * pdy1(1)
159 zyhat1(2) = zym1(1) + 0.5 * pdy1(1)
161 zyhat1(1) = 1.5 * zym1(1) - 0.5 * zym1(2)
163 zyhat1(jj) = 0.5 * zym1(jj-1) + 0.5 * zym1(jj)
165 zyhat1(kjmax1+1) = 1.5 * zym1(kjmax1) - 0.5 * zym1(kjmax1-1)
176 jibox=(ji-1)/kdxratio + kxor
177 zcoef= float(mod(ji-1,kdxratio))/float(kdxratio)
178 zxhat2(ji)=(1.-zcoef)*zxhat1(jibox)+zcoef*zxhat1(jibox+1)
181 zxhat2(kimax2+1) = zxhat2(kimax2) + zxhat1(jibox+1) - zxhat1(jibox)
183 zxhat2(kimax2+1) = 2. * zxhat2(kimax2) - zxhat2(kimax2-1)
190 jjbox=(jj-1)/kdyratio + kyor
191 zcoef= float(mod(jj-1,kdyratio))/float(kdyratio)
192 zyhat2(jj)=(1.-zcoef)*zyhat1(jjbox)+zcoef*zyhat1(jjbox+1)
195 zyhat2(kjmax2+1) = zyhat2(kjmax2) + zyhat1(jjbox+1) - zyhat1(jjbox)
197 zyhat2(kjmax2+1) = 2. * zyhat2(kjmax2) - zyhat2(kjmax2-1)
211 jl = (jj-1) * kimax2 + ji
212 px2(jl) = 0.5 * zxhat2(ji) + 0.5 * zxhat2(ji+1)
213 pdx2(jl) = zxhat2(ji+1) - zxhat2(ji)
214 py2(jl) = 0.5 * zyhat2(jj) + 0.5 * zyhat2(jj+1)
215 pdy2(jl) = zyhat2(jj+1) - zyhat2(jj)
222 IF (lhook) CALL dr_hook(
'REGULAR_GRID_SPAWN',1,zhook_handle)
subroutine regular_grid_spawn(KLUOUT, KL1, KIMAX1, KJMAX1, PX1, PY1, PDX1, PDY1, KXOR, KYOR, KDXRATIO, KDYRATIO, KXSIZE, KYSIZE, KL2, KIMAX2, KJMAX2, PX2, PY2, PDX2, PDY2)
subroutine abor1_sfx(YTEXT)