Linux R2.6.5-7.282-sn2 FORTRAN90/SX Rev.360 Tue Oct 11 12:35:21 2011 FILE NAME: initialdata_disturb.f90 PROGRAM NAME: initialdata_disturb DIAGNOSTIC LIST LINE LEVEL( NO.): DIAGNOSTIC MESSAGE 77 vec ( 4): Vectorized array expression. 83 vec ( 3): Unvectorized loop. 96 vec ( 1): Vectorized loop. 105 vec ( 2): Partially vectorized loop. 106 vec ( 4): Vectorized array expression. 124 vec ( 1): Vectorized loop. 124 vec ( 1): Vectorized loop. 149 vec ( 1): Vectorized loop. 149 vec ( 1): Vectorized loop. 174 vec ( 1): Vectorized loop. 174 vec ( 1): Vectorized loop. 199 vec ( 1): Vectorized loop. 232 vec ( 1): Vectorized loop. 232 vec ( 1): Vectorized loop. 271 vec ( 4): Vectorized array expression. 271 vec ( 4): Vectorized array expression. 278 vec ( 1): Vectorized loop. 278 vec ( 1): Vectorized loop. Linux R2.6.5-7.282-sn2 FORTRAN90/SX Rev.360 Tue Oct 11 12:35:21 2011 FILE NAME: initialdata_disturb.f90 PROGRAM NAME: initialdata_disturb TRANSFORMATION LIST LINE FORTRAN STATEMENT 1 !--------------------------------------------------------------------- 2 ! Copyright (C) GFD Dennou Club, 2004, 2005. All rights reserved. 3 !--------------------------------------------------------------------- 4 != Module DisturbEnv 5 ! 6 ! * Developer: SUGIYAMA Ko-ichiro, ODAKA Masatsugu 7 ! * Version: $Id: initialdata_disturb.f90,v 1.11 2011-06-27 02:42:35 sugiyama Exp $ 8 ! * Tag Name: $Name: arare5-20111010 $ 9 ! * Change History: 10 ! 11 !== Overview 12 ! 13 ! 擾乱のデフォルト値を与えるための基本関数群. 14 ! 15 !== Error Handling 16 ! 17 !== Known Bugs 18 ! 19 !== Note 20 ! 21 !== Future Plans 22 ! 23 ! 24 25 module initialdata_disturb 26 ! 27 !擾乱のデフォルト値を与えるためのルーチン. 28 ! 29 30 !モジュール読み込み 31 use dc_types, only: STRING, DP 32 use dc_message, only: MessageNotify 33 use mpi_wrapper,only: myrank, nprocs 34 use axesset, only: & 35 & x_X, &! X 座標軸(スカラー格子点) 36 & y_Y, &! X 座標軸(スカラー格子点) 37 & z_Z ! Z 座標軸(スカラー格子点) 38 use gridset, only: & 39 & imin, &! 配列の X 方向の下限 40 & imax, &! 配列の X 方向の上限 41 & jmin, &! 配列の Y 方向の下限 42 & jmax, &! 配列の Y 方向の上限 43 & kmin, &! 配列の Z 方向の下限 44 & kmax, &! 配列の Z 方向の上限 45 & nx, &! 配列の Z 方向の下限 46 & ny, &! 配列の Z 方向の上限 47 & nz, &! 計算領域のマージン 48 & ncmax ! 計算領域のマージン 49 50 !暗黙の型宣言禁止 51 implicit none 52 53 !属性 54 private 55 56 public initialdata_disturb_random 57 public initialdata_disturb_gaussXZ 58 public initialdata_disturb_gaussXY 59 public initialdata_disturb_gaussYZ 60 public initialdata_disturb_gaussXYZ 61 public initialdata_disturb_dryreg 62 public initialdata_disturb_moist 63 64 contains 65 66 subroutine initialdata_disturb_random( DelMax, Zpos, xyz_Var ) 67 68 implicit none 69 70 real(DP), intent(in) :: DelMax, Zpos 71 real(DP), intent(out) :: xyz_Var(imin:imax,jmin:jmax,kmin:kmax) 72 real(DP) :: Random !ファイルから取得した乱数 73 real(DP) :: Random1(imin:imax, jmin:jmax) 74 integer :: i, j, k, kpos, ix, jy 75 76 ! 初期化 77 xyz_Var = 0.0d0 . !CDIR NODEP . !CDIR NOASSUME . do t184 = 1, (kmax + 1 - kmin)*(jmax + 1 - jmin)*(imax + 1 - imin) . xyz_var(t15+t184-1,t17,t19) = 0.0000000000000000e+000 . end do 78 79 ! 0.0--1.0 の擬似乱数発生 80 ! mpi の場合に, 各 CPU の持つ乱数が異なるよう調整している. 81 ! 82 do j = jmin, jmax + ( ny * nprocs ) 83 do i = imin, imax * ( nx * nprocs ) 84 call random_number(random) 85 if (imin + nx * myrank <= i .AND. i <= imax + nx * myrank) then 86 if (jmin + ny * myrank <= j .AND. j <= jmax + ny * myrank) then 87 ix = i - nx * myrank 88 jy = j - ny * myrank 89 Random1(ix,jy) = random 90 end if 91 end if 92 end do . !CDIR NODEP . do i = 1, imax*nx*nprocs + 1 - imin . call e_drdmnum (random) . if (imin + nx*myrank.le.imin+i-1 .and. imin+i-1.le.imax+nx* . 1 myrank) then . if (jmin + ny*myrank.le.j .and. j.le.jmax+ny*myrank) then . random1(imin-nx*myrank+i-1,j-ny*myrank) = random . endif . endif . end do 93 end do 94 95 ! 指定された高度の配列添字を用意 96 do k = kmin, kmax 97 if ( z_Z(k) >= Zpos ) then 98 kpos = k 99 exit 100 end if 101 end do 102 103 ! 擾乱が全体としてはゼロとなるように調整. 平均からの差にする. 104 do j = 1, ny 105 do i = 1, nx 106 xyz_Var(i, j, kpos) = & . !CDIR NODEP . do t159 = 1, nx . t155 = t155 + random1(t159,t157) . end do 107 & DelMax * (Random1(i,j) - sum( Random1(1:nx,1:ny) ) / real((nx * ny),8)) 108 end do 109 end do 110 111 end subroutine initialdata_disturb_random 112 113 114 subroutine initialdata_disturb_gaussXZ(DelMax, Xc, Xr, Zc, Zr, xyz_Var) 115 116 implicit none 117 118 real(DP), intent(in) :: DelMax, Xc, Xr, Zc, Zr 119 real(DP), intent(out) :: xyz_Var(imin:imax, jmin:jmax, kmin:kmax) 120 integer :: i, j, k 121 122 do k = kmin, kmax 123 do j = jmin, jmax 124 do i = imin, imax 125 xyz_Var(i,j,k) = & 126 & DelMax * dexp( - ( (x_X(i) - Xc) / Xr )**2.0d0 * 5.0d-1 & 127 & - ( (z_Z(k) - Zc) / Zr )**2.0d0 * 5.0d-1 ) 128 end do 129 end do . if (jmax + 1 - jmin .gt. 0) then . J1 = and(jmax + 1 - jmin,3) . do j = 1, J1 . D3 = 1.D0/xr . !CDIR NODEP . do i = 1, imax + 1 - imin . xyz_var(imin+i-1,j-1+jmin,k) = delmax*dexp((-((x_x(imin+i . 1 -1)-xc)*D3)**2.00000000000000e+000* . 2 5.00000000000000e-001)-((z_z(k)-zc)/zr)** . 3 2.00000000000000e+000*5.00000000000000e-001) . end do . end do . do j = J1 + 1, jmax + 1 - jmin, 4 . D4 = 1.D0/xr . D5 = 1.D0/zr . D6 = 1.D0/xr . D7 = 1.D0/zr . D8 = 1.D0/xr . D9 = 1.D0/zr . D10 = 1.D0/xr . D11 = 1.D0/zr . D2 = z_z(k) . !CDIR NODEP . do i = 1, imax + 1 - imin . D1 = x_x(imin+i-1) . xyz_var(imin+i-1,j-1+jmin,k) = delmax*dexp((-((D1 - xc)* . 1 D4)**2.00000000000000e+000*5.00000000000000e-001) - (( . 2 D2 - zc)*D5)**2.00000000000000e+000* . 3 5.00000000000000e-001) . xyz_var(imin+i-1,j+jmin,k) = delmax*dexp((-((D1 - xc)*D6) . 1 **2.00000000000000e+000*5.00000000000000e-001) - ((D2 . 2 - zc)*D7)**2.00000000000000e+000* . 3 5.00000000000000e-001) . xyz_var(imin+i-1,j+1+jmin,k) = delmax*dexp((-((D1 - xc)* . 1 D8)**2.00000000000000e+000*5.00000000000000e-001) - (( . 2 D2 - zc)*D9)**2.00000000000000e+000* . 3 5.00000000000000e-001) . xyz_var(imin+i-1,j+2+jmin,k) = delmax*dexp((-((D1 - xc)* . 1 D10)**2.00000000000000e+000*5.00000000000000e-001) - ( . 2 (D2 - zc)*D11)**2.00000000000000e+000* . 3 5.00000000000000e-001) . end do . end do . endif 130 end do 131 132 ! where ( xyz_Var < DelMax * 1.0d-2) 133 ! xyz_Var = 0.0d0 134 ! end where 135 136 end subroutine initialdata_disturb_gaussXZ 137 138 139 subroutine initialdata_disturb_gaussXY(DelMax, Xc, Xr, Yc, Yr, xyz_Var) 140 141 implicit none 142 143 real(DP), intent(in) :: DelMax, Xc, Xr, Yc, Yr 144 real(DP), intent(out) :: xyz_Var(imin:imax, jmin:jmax, kmin:kmax) 145 integer :: i, j, k 146 147 do k = kmin, kmax 148 do j = jmin, jmax 149 do i = imin, imax 150 xyz_Var(i,j,k) = & 151 & DelMax * dexp( - ( (x_X(i) - Xc) / Xr )**2.0d0 * 5.0d-1 & 152 & - ( (y_Y(j) - Yc) / Yr )**2.0d0 * 5.0d-1 ) 153 end do 154 end do . if (jmax + 1 - jmin .gt. 0) then . J1 = and(jmax + 1 - jmin,3) . do j = 1, J1 . D2 = 1.D0/xr . !CDIR NODEP . do i = 1, imax + 1 - imin . xyz_var(imin+i-1,j-1+jmin,k) = delmax*dexp((-((x_x(imin+i . 1 -1)-xc)*D2)**2.00000000000000e+000* . 2 5.00000000000000e-001)-((y_y(j-1+jmin)-yc)/yr)** . 3 2.00000000000000e+000*5.00000000000000e-001) . end do . end do . do j = J1 + 1, jmax + 1 - jmin, 4 . D3 = 1.D0/xr . D4 = 1.D0/yr . D5 = 1.D0/xr . D6 = 1.D0/yr . D7 = 1.D0/xr . D8 = 1.D0/yr . D9 = 1.D0/xr . D10 = 1.D0/yr . !CDIR NODEP . do i = 1, imax + 1 - imin . D1 = x_x(imin+i-1) . xyz_var(imin+i-1,j-1+jmin,k) = delmax*dexp((-((D1 - xc)* . 1 D3)**2.00000000000000e+000*5.00000000000000e-001) - (( . 2 y_y(j-1+jmin)-yc)*D4)**2.00000000000000e+000* . 3 5.00000000000000e-001) . xyz_var(imin+i-1,j+jmin,k) = delmax*dexp((-((D1 - xc)*D5) . 1 **2.00000000000000e+000*5.00000000000000e-001) - ((y_y . 2 (j+jmin)-yc)*D6)**2.00000000000000e+000* . 3 5.00000000000000e-001) . xyz_var(imin+i-1,j+1+jmin,k) = delmax*dexp((-((D1 - xc)* . 1 D7)**2.00000000000000e+000*5.00000000000000e-001) - (( . 2 y_y(j+1+jmin)-yc)*D8)**2.00000000000000e+000* . 3 5.00000000000000e-001) . xyz_var(imin+i-1,j+2+jmin,k) = delmax*dexp((-((D1 - xc)* . 1 D9)**2.00000000000000e+000*5.00000000000000e-001) - (( . 2 y_y(j+2+jmin)-yc)*D10)**2.00000000000000e+000* . 3 5.00000000000000e-001) . end do . end do . endif 155 end do 156 157 ! where ( xyz_Var < DelMax * 1.0d-2) 158 ! xyz_Var = 0.0d0 159 ! end where 160 161 end subroutine initialdata_disturb_gaussXY 162 163 164 subroutine initialdata_disturb_gaussYZ(DelMax, Yc, Yr, Zc, Zr, xyz_Var) 165 166 implicit none 167 168 real(DP), intent(in) :: DelMax, Yc, Yr, Zc, Zr 169 real(DP), intent(out) :: xyz_Var(imin:imax, jmin:jmax, kmin:kmax) 170 integer :: i, j, k 171 172 do k = kmin, kmax 173 do j = jmin, jmax 174 do i = imin, imax 175 xyz_Var(i,j,k) = & 176 & DelMax * dexp( - ( (z_Z(k) - Zc) / Zr )**2.0d0 * 5.0d-1 & 177 & - ( (y_Y(j) - Yc) / Yr )**2.0d0 * 5.0d-1 ) 178 end do 179 end do . if (jmax + 1 - jmin .gt. 0) then . J1 = and(jmax + 1 - jmin,3) . do j = 1, J1 . D2 = 1.D0/zr . D3 = 1.D0/yr . !CDIR NODEP . do i = 1, imax + 1 - imin . xyz_var(imin+i-1,j-1+jmin,k) = delmax*dexp((-((z_z(k)-zc) . 1 *D2)**2.00000000000000e+000*5.00000000000000e-001)-(( . 2 y_y(j-1+jmin)-yc)*D3)**2.00000000000000e+000* . 3 5.00000000000000e-001) . end do . end do . do j = J1 + 1, jmax + 1 - jmin, 4 . D4 = 1.D0/zr . D5 = 1.D0/yr . D6 = 1.D0/zr . D7 = 1.D0/yr . D8 = 1.D0/zr . D9 = 1.D0/yr . D10 = 1.D0/zr . D11 = 1.D0/yr . D1 = z_z(k) . !CDIR NODEP . do i = 1, imax + 1 - imin . xyz_var(imin+i-1,j-1+jmin,k) = delmax*dexp((-((D1 - zc)* . 1 D4)**2.00000000000000e+000*5.00000000000000e-001) - (( . 2 y_y(j-1+jmin)-yc)*D5)**2.00000000000000e+000* . 3 5.00000000000000e-001) . xyz_var(imin+i-1,j+jmin,k) = delmax*dexp((-((D1 - zc)*D6) . 1 **2.00000000000000e+000*5.00000000000000e-001) - ((y_y . 2 (j+jmin)-yc)*D7)**2.00000000000000e+000* . 3 5.00000000000000e-001) . xyz_var(imin+i-1,j+1+jmin,k) = delmax*dexp((-((D1 - zc)* . 1 D8)**2.00000000000000e+000*5.00000000000000e-001) - (( . 2 y_y(j+1+jmin)-yc)*D9)**2.00000000000000e+000* . 3 5.00000000000000e-001) . xyz_var(imin+i-1,j+2+jmin,k) = delmax*dexp((-((D1 - zc)* . 1 D10)**2.00000000000000e+000*5.00000000000000e-001) - ( . 2 (y_y(j+2+jmin)-yc)*D11)**2.00000000000000e+000* . 3 5.00000000000000e-001) . end do . end do . endif 180 end do 181 182 ! where ( xyz_Var < DelMax * 1.0d-2) 183 ! xyz_Var = 0.0d0 184 ! end where 185 186 end subroutine initialdata_disturb_gaussYZ 187 188 189 subroutine initialdata_disturb_gaussXYZ(DelMax, Xc, Xr, Yc, Yr, Zc, Zr, xyz_Var) 190 191 implicit none 192 193 real(DP), intent(in) :: DelMax, Xc, Xr, Yc, Yr, Zc, Zr 194 real(DP), intent(out) :: xyz_Var(imin:imax, jmin:jmax, kmin:kmax) 195 integer :: i, j, k 196 197 do k = kmin, kmax 198 do j = jmin, jmax 199 do i = imin, imax 200 xyz_Var(i,j,k) = & 201 & DelMax * dexp( - ( (x_X(i) - Xc) / Xr )**2.0d0 * 5.0d-1 & 202 & - ( (y_Y(j) - Yc) / Yr )**2.0d0 * 5.0d-1 & 203 & - ( (z_Z(k) - Zc) / Zr )**2.0d0 * 5.0d-1 ) 204 end do . D1 = 1.D0/xr . !CDIR NODEP . do i = 1, imax + 1 - imin . xyz_var(imin+i-1,j,k) = delmax*dexp((-((x_x(imin+i-1)-xc)*D1)** . 1 2.00000000000000e+000*5.00000000000000e-001)-((y_y(j)-yc)/yr . 2 )**2.00000000000000e+000*5.00000000000000e-001-((z_z(k)-zc)/ . 3 zr)**2.00000000000000e+000*5.00000000000000e-001) . end do 205 end do 206 end do 207 208 ! where ( xyz_Var < DelMax * 1.0d-2) 209 ! xyz_Var = 0.0d0 210 ! end where 211 212 end subroutine initialdata_disturb_gaussXYZ 213 214 215 subroutine initialdata_disturb_dryreg( & 216 & XposMin, XposMax, YposMin, YposMax, ZposMin, ZposMax, & 217 & xyzf_QMix) 218 219 use basicset, only: xyzf_QMixBZ 220 221 implicit none 222 223 real(DP), intent(in) ::XposMin, XposMax, YposMin, YposMax, ZposMin, ZposMax 224 real(DP), intent(out) :: xyzf_QMix(imin:imax, jmin:jmax, kmin:kmax, 1:ncmax) 225 integer :: i, j, k, s 226 227 ! XposMin:XposMax,ZposMin:ZposMax で囲まれた領域の初期の湿度をゼロにするために 228 ! 基本場と逆符号の水蒸気擾乱を与える 229 do s = 1, ncmax 230 do k = kmin,kmax 231 do j = jmin, jmax 232 do i = imin,imax 233 if (z_Z(k) >= ZposMin .AND. z_Z(k) < ZposMax & 234 & .AND. y_Y(j) >= YposMin .AND. y_Y(j) < YposMax & 235 & .AND. x_X(i) >= XposMin .AND. x_X(i) < XposMax) then 236 xyzf_QMix(i,j,k,s) = - xyzf_QMixBZ(i,j,k,s) 237 end if 238 end do 239 end do . if (jmax + 1 - jmin .gt. 0) then . J1 = and(jmax + 1 - jmin,1) . do j = 1, J1 . !CDIR NODEP . do i = 1, imax + 1 - imin . if (z_z(k).ge.zposmin .and. z_z(k).lt.zposmax .and. y_y(j . 1 -1+jmin).ge.yposmin .and. y_y(j-1+jmin).lt.yposmax . 2 .and. x_x(imin+i-1).ge.xposmin .and. x_x(imin+i-1) . 3 .lt.xposmax) then . xyzf_qmix(imin+i-1,j-1+jmin,k,s) = -xyzf_qmixbz(imin+i . 1 -1,j-1+jmin,k,s) . endif . end do . end do . do j = J1 + 1, jmax + 1 - jmin, 2 . !CDIR NODEP . do i = 1, imax + 1 - imin . if (z_z(k).ge.zposmin .and. z_z(k).lt.zposmax .and. y_y(j . 1 -1+jmin).ge.yposmin .and. y_y(j-1+jmin).lt.yposmax . 2 .and. x_x(imin+i-1).ge.xposmin .and. x_x(imin+i-1) . 3 .lt.xposmax) then . xyzf_qmix(imin+i-1,j-1+jmin,k,s) = -xyzf_qmixbz(imin+i . 1 -1,j-1+jmin,k,s) . endif . if (z_z(k).ge.zposmin .and. z_z(k).lt.zposmax .and. y_y(j . 1 +jmin).ge.yposmin .and. y_y(j+jmin).lt.yposmax .and. . 2 x_x(imin+i-1).ge.xposmin .and. x_x(imin+i-1).lt. . 3 xposmax) then . xyzf_qmix(imin+i-1,j+jmin,k,s) = -xyzf_qmixbz(imin+i-1 . 1 ,j+jmin,k,s) . endif . end do . end do . endif 240 end do 241 end do 242 243 end subroutine initialdata_disturb_dryreg 244 245 246 subroutine initialdata_disturb_moist(Hum, xyzf_QMix) 247 248 use basicset, only: & 249 & xyz_TempBZ, &! 基本場の温度 250 & xyz_PressBZ, &! 基本場の圧力 251 & xyzf_QMixBZ ! 基本場の混合比 252 use composition, only: & 253 & MolWtWet, &!凝縮成分の分子量 254 & SpcWetMolFr !凝縮成分の初期モル比 255 use constants, only: MolWtDry !乾燥成分の分子量 256 use eccm, only: eccm_molfr 257 258 implicit none 259 260 real(DP), intent(in) :: Hum 261 real(DP), intent(out) :: xyzf_QMix(imin:imax, jmin:jmax, kmin:kmax, 1:ncmax) 262 real(DP) :: zf_MolFr(kmin:kmax, 1:ncmax) 263 integer :: i, j, k, s 264 265 ! 湿度ゼロなら何もしない 266 if ( Hum == 0.0d0 ) return 267 268 ! 水平一様なので, i=0 だけ計算. 269 i = 1 270 j = 1 271 call eccm_molfr( SpcWetMolFr(1:ncmax), Hum, xyz_TempBZ(i,j,:), & 272 & xyz_PressBZ(i,j,:), zf_MolFr ) 273 274 !気相のモル比を混合比に変換 275 do s = 1, ncmax 276 do k = 1, nz 277 do j = 1, ny 278 do i = 1, nx 279 xyzf_QMix(i,j,k,s) = zf_MolFr(k,s) * MolWtWet(s) / MolWtDry - xyzf_QMixBZ(i,j,k,s) 280 end do 281 end do . if (ny .gt. 0) then . J1 = and(ny,3) . do j = 1, J1 . !CDIR NODEP . do i = 1, nx . xyzf_qmix(i,j,k,s) = zf_molfr(k,s)*molwtwet(s)/molwtdry . 1 - xyzf_qmixbz(i,j,k,s) . end do . end do . do j = J1 + 1, ny, 4 . D2 = molwtwet(s) . D1 = zf_molfr(k,s) . !CDIR NODEP . do i = 1, nx . xyzf_qmix(i,j,k,s)=D1*D2/molwtdry-xyzf_qmixbz(i,j,k,s) . xyzf_qmix(i,j+1,k,s) = D1*D2/molwtdry - xyzf_qmixbz(i,j+1 . 1 ,k,s) . xyzf_qmix(i,j+2,k,s) = D1*D2/molwtdry - xyzf_qmixbz(i,j+2 . 1 ,k,s) . xyzf_qmix(i,j+3,k,s) = D1*D2/molwtdry - xyzf_qmixbz(i,j+3 . 1 ,k,s) . end do . end do . endif 282 end do 283 end do 284 285 end subroutine initialdata_disturb_moist 286 287 end module initialdata_disturb Linux R2.6.5-7.282-sn2 FORTRAN90/SX Rev.360 Tue Oct 11 12:35:21 2011 FILE NAME: initialdata_disturb.f90 PROGRAM NAME: initialdata_disturb FORMAT LIST LINE LOOP FORTRAN STATEMENT 1: !--------------------------------------------------------------------- 2: ! Copyright (C) GFD Dennou Club, 2004, 2005. All rights reserved. 3: !--------------------------------------------------------------------- 4: != Module DisturbEnv 5: ! 6: ! * Developer: SUGIYAMA Ko-ichiro, ODAKA Masatsugu 7: ! * Version: $Id: initialdata_disturb.f90,v 1.11 2011-06-27 02:42:35 sugiyama Exp $ 8: ! * Tag Name: $Name: arare5-20111010 $ 9: ! * Change History: 10: ! 11: !== Overview 12: ! 13: ! 擾乱のデフォルト値を与えるための基本関数群. 14: ! 15: !== Error Handling 16: ! 17: !== Known Bugs 18: ! 19: !== Note 20: ! 21: !== Future Plans 22: ! 23: ! 24: 25: module initialdata_disturb 26: ! 27: !擾乱のデフォルト値を与えるためのルーチン. 28: ! 29: 30: !モジュール読み込み 31: use dc_types, only: STRING, DP 32: use dc_message, only: MessageNotify 33: use mpi_wrapper,only: myrank, nprocs 34: use axesset, only: & 35: & x_X, &! X 座標軸(スカラー格子点) 36: & y_Y, &! X 座標軸(スカラー格子点) 37: & z_Z ! Z 座標軸(スカラー格子点) 38: use gridset, only: & 39: & imin, &! 配列の X 方向の下限 40: & imax, &! 配列の X 方向の上限 41: & jmin, &! 配列の Y 方向の下限 42: & jmax, &! 配列の Y 方向の上限 43: & kmin, &! 配列の Z 方向の下限 44: & kmax, &! 配列の Z 方向の上限 45: & nx, &! 配列の Z 方向の下限 46: & ny, &! 配列の Z 方向の上限 47: & nz, &! 計算領域のマージン 48: & ncmax ! 計算領域のマージン 49: 50: !暗黙の型宣言禁止 51: implicit none 52: 53: !属性 54: private 55: 56: public initialdata_disturb_random 57: public initialdata_disturb_gaussXZ 58: public initialdata_disturb_gaussXY 59: public initialdata_disturb_gaussYZ 60: public initialdata_disturb_gaussXYZ 61: public initialdata_disturb_dryreg 62: public initialdata_disturb_moist 63: 64: contains 65: 66: subroutine initialdata_disturb_random( DelMax, Zpos, xyz_Var ) 67: 68: implicit none 69: 70: real(DP), intent(in) :: DelMax, Zpos 71: real(DP), intent(out) :: xyz_Var(imin:imax,jmin:jmax,kmin:kmax) 72: real(DP) :: Random !ファイルから取得した乱数 73: real(DP) :: Random1(imin:imax, jmin:jmax) 74: integer :: i, j, k, kpos, ix, jy 75: 76: ! 初期化 77: W**==== xyz_Var = 0.0d0 78: 79: ! 0.0--1.0 の擬似乱数発生 80: ! mpi の場合に, 各 CPU の持つ乱数が異なるよう調整している. 81: ! 82: +------> do j = jmin, jmax + ( ny * nprocs ) 83: |+-----> do i = imin, imax * ( nx * nprocs ) 84: || call random_number(random) 85: || if (imin + nx * myrank <= i .AND. i <= imax + nx * myrank) then 86: || if (jmin + ny * myrank <= j .AND. j <= jmax + ny * myrank) then 87: || ix = i - nx * myrank 88: || jy = j - ny * myrank 89: || Random1(ix,jy) = random 90: || end if 91: || end if 92: |+----- end do 93: +------ end do 94: 95: ! 指定された高度の配列添字を用意 96: V------> do k = kmin, kmax 97: | if ( z_Z(k) >= Zpos ) then 98: | kpos = k 99: | exit 100: | end if 101: V------ end do 102: 103: ! 擾乱が全体としてはゼロとなるように調整. 平均からの差にする. 104: +------> do j = 1, ny 105: |V-----> do i = 1, nx 106: ||+V=== xyz_Var(i, j, kpos) = & 107: || & DelMax * (Random1(i,j) - sum( Random1(1:nx,1:ny) ) / real((nx * ny),8)) 108: |V----- end do 109: +------ end do 110: 111: end subroutine initialdata_disturb_random 112: 113: 114: subroutine initialdata_disturb_gaussXZ(DelMax, Xc, Xr, Zc, Zr, xyz_Var) 115: 116: implicit none 117: 118: real(DP), intent(in) :: DelMax, Xc, Xr, Zc, Zr 119: real(DP), intent(out) :: xyz_Var(imin:imax, jmin:jmax, kmin:kmax) 120: integer :: i, j, k 121: 122: +------> do k = kmin, kmax 123: |+-----> do j = jmin, jmax 124: ||V----> do i = imin, imax 125: ||| xyz_Var(i,j,k) = & 126: ||| & DelMax * dexp( - ( (x_X(i) - Xc) / Xr )**2.0d0 * 5.0d-1 & 127: ||| & - ( (z_Z(k) - Zc) / Zr )**2.0d0 * 5.0d-1 ) 128: ||V---- end do 129: |+----- end do 130: +------ end do 131: 132: ! where ( xyz_Var < DelMax * 1.0d-2) 133: ! xyz_Var = 0.0d0 134: ! end where 135: 136: end subroutine initialdata_disturb_gaussXZ 137: 138: 139: subroutine initialdata_disturb_gaussXY(DelMax, Xc, Xr, Yc, Yr, xyz_Var) 140: 141: implicit none 142: 143: real(DP), intent(in) :: DelMax, Xc, Xr, Yc, Yr 144: real(DP), intent(out) :: xyz_Var(imin:imax, jmin:jmax, kmin:kmax) 145: integer :: i, j, k 146: 147: +------> do k = kmin, kmax 148: |+-----> do j = jmin, jmax 149: ||V----> do i = imin, imax 150: ||| xyz_Var(i,j,k) = & 151: ||| & DelMax * dexp( - ( (x_X(i) - Xc) / Xr )**2.0d0 * 5.0d-1 & 152: ||| & - ( (y_Y(j) - Yc) / Yr )**2.0d0 * 5.0d-1 ) 153: ||V---- end do 154: |+----- end do 155: +------ end do 156: 157: ! where ( xyz_Var < DelMax * 1.0d-2) 158: ! xyz_Var = 0.0d0 159: ! end where 160: 161: end subroutine initialdata_disturb_gaussXY 162: 163: 164: subroutine initialdata_disturb_gaussYZ(DelMax, Yc, Yr, Zc, Zr, xyz_Var) 165: 166: implicit none 167: 168: real(DP), intent(in) :: DelMax, Yc, Yr, Zc, Zr 169: real(DP), intent(out) :: xyz_Var(imin:imax, jmin:jmax, kmin:kmax) 170: integer :: i, j, k 171: 172: +------> do k = kmin, kmax 173: |+-----> do j = jmin, jmax 174: ||V----> do i = imin, imax 175: ||| xyz_Var(i,j,k) = & 176: ||| & DelMax * dexp( - ( (z_Z(k) - Zc) / Zr )**2.0d0 * 5.0d-1 & 177: ||| & - ( (y_Y(j) - Yc) / Yr )**2.0d0 * 5.0d-1 ) 178: ||V---- end do 179: |+----- end do 180: +------ end do 181: 182: ! where ( xyz_Var < DelMax * 1.0d-2) 183: ! xyz_Var = 0.0d0 184: ! end where 185: 186: end subroutine initialdata_disturb_gaussYZ 187: 188: 189: subroutine initialdata_disturb_gaussXYZ(DelMax, Xc, Xr, Yc, Yr, Zc, Zr, xyz_Var) 190: 191: implicit none 192: 193: real(DP), intent(in) :: DelMax, Xc, Xr, Yc, Yr, Zc, Zr 194: real(DP), intent(out) :: xyz_Var(imin:imax, jmin:jmax, kmin:kmax) 195: integer :: i, j, k 196: 197: +------> do k = kmin, kmax 198: |+-----> do j = jmin, jmax 199: ||V----> do i = imin, imax 200: ||| xyz_Var(i,j,k) = & 201: ||| & DelMax * dexp( - ( (x_X(i) - Xc) / Xr )**2.0d0 * 5.0d-1 & 202: ||| & - ( (y_Y(j) - Yc) / Yr )**2.0d0 * 5.0d-1 & 203: ||| & - ( (z_Z(k) - Zc) / Zr )**2.0d0 * 5.0d-1 ) 204: ||V---- end do 205: |+----- end do 206: +------ end do 207: 208: ! where ( xyz_Var < DelMax * 1.0d-2) 209: ! xyz_Var = 0.0d0 210: ! end where 211: 212: end subroutine initialdata_disturb_gaussXYZ 213: 214: 215: subroutine initialdata_disturb_dryreg( & 216: & XposMin, XposMax, YposMin, YposMax, ZposMin, ZposMax, & 217: & xyzf_QMix) 218: 219: use basicset, only: xyzf_QMixBZ 220: 221: implicit none 222: 223: real(DP), intent(in) ::XposMin, XposMax, YposMin, YposMax, ZposMin, ZposMax 224: real(DP), intent(out) :: xyzf_QMix(imin:imax, jmin:jmax, kmin:kmax, 1:ncmax) 225: integer :: i, j, k, s 226: 227: ! XposMin:XposMax,ZposMin:ZposMax で囲まれた領域の初期の湿度をゼロにするために 228: ! 基本場と逆符号の水蒸気擾乱を与える 229: +------> do s = 1, ncmax 230: |+-----> do k = kmin,kmax 231: ||+----> do j = jmin, jmax 232: |||V---> do i = imin,imax 233: |||| if (z_Z(k) >= ZposMin .AND. z_Z(k) < ZposMax & 234: |||| & .AND. y_Y(j) >= YposMin .AND. y_Y(j) < YposMax & 235: |||| & .AND. x_X(i) >= XposMin .AND. x_X(i) < XposMax) then 236: |||| xyzf_QMix(i,j,k,s) = - xyzf_QMixBZ(i,j,k,s) 237: |||| end if 238: |||V--- end do 239: ||+---- end do 240: |+----- end do 241: +------ end do 242: 243: end subroutine initialdata_disturb_dryreg 244: 245: 246: subroutine initialdata_disturb_moist(Hum, xyzf_QMix) 247: 248: use basicset, only: & 249: & xyz_TempBZ, &! 基本場の温度 250: & xyz_PressBZ, &! 基本場の圧力 251: & xyzf_QMixBZ ! 基本場の混合比 252: use composition, only: & 253: & MolWtWet, &!凝縮成分の分子量 254: & SpcWetMolFr !凝縮成分の初期モル比 255: use constants, only: MolWtDry !乾燥成分の分子量 256: use eccm, only: eccm_molfr 257: 258: implicit none 259: 260: real(DP), intent(in) :: Hum 261: real(DP), intent(out) :: xyzf_QMix(imin:imax, jmin:jmax, kmin:kmax, 1:ncmax) 262: real(DP) :: zf_MolFr(kmin:kmax, 1:ncmax) 263: integer :: i, j, k, s 264: 265: ! 湿度ゼロなら何もしない 266: if ( Hum == 0.0d0 ) return 267: 268: ! 水平一様なので, i=0 だけ計算. 269: i = 1 270: j = 1 271: V====== call eccm_molfr( SpcWetMolFr(1:ncmax), Hum, xyz_TempBZ(i,j,:), & 272: & xyz_PressBZ(i,j,:), zf_MolFr ) 273: 274: !気相のモル比を混合比に変換 275: +------> do s = 1, ncmax 276: |+-----> do k = 1, nz 277: ||+----> do j = 1, ny 278: |||V---> do i = 1, nx 279: |||| xyzf_QMix(i,j,k,s) = zf_MolFr(k,s) * MolWtWet(s) / MolWtDry - xyzf_QMixBZ(i,j,k,s) 280: |||V--- end do 281: ||+---- end do 282: |+----- end do 283: +------ end do 284: 285: end subroutine initialdata_disturb_moist 286: 287: end module initialdata_disturb