Changeset 188 for LMDZ.3.3/trunk/libf
- Timestamp:
- Mar 29, 2001, 10:46:42 AM (24 years ago)
- File:
-
- 1 edited
-
LMDZ.3.3/trunk/libf/phylmd/phystokenc.F (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/trunk/libf/phylmd/phystokenc.F
r52 r188 1 1 SUBROUTINE phystokenc ( 2 2 I nlon,nlev,pdtphys,rlon,rlat, 3 I p mfu, pmfd, pen_u, pde_u, pen_d, pde_d,3 I pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, 4 4 I pcoefh,yu1,yv1,ftsol,pctsrf, 5 5 I frac_impa,frac_nucl, 6 I pphis,paire,dtime,itap, 7 O physid) 6 I pphis,paire,dtime,itap) 8 7 USE ioipsl 9 8 … … 35 34 real pdtphys ! pas d'integration pour la physique (seconde) 36 35 c 37 integer physid, itap 38 integer ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev) 36 integer physid, itap,ndex(1) 39 37 40 38 c convection: … … 47 45 REAL pen_d(klon,klev) ! flux entraine dans le panache descendant 48 46 REAL pde_d(klon,klev) ! flux detraine dans le panache descendant 47 REAL pt(klon,klev) 49 48 c 50 49 REAL rlon(klon), rlat(klon), dtime … … 79 78 REAL de_d(klon,klev) ! flux detraine dans le panache descendant 80 79 REAL coefh(klon,klev) ! flux detraine dans le panache descendant 80 REAL t(klon,klev) 81 81 82 82 REAL pyu1(klon),pyv1(klon) … … 89 89 integer iadvtr,irec 90 90 real zmin,zmax 91 logical ok_sync 92 93 save mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum 91 92 save t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum 94 93 save iadvtr,irec 95 94 save pyu1,pyv1,pftsol,ppsrf … … 100 99 c====================================================================== 101 100 102 ok_sync = .true. 103 104 c print*,'iadvtr= ',iadvtr 105 c print*,'istphy= ',istphy 106 c print*,'istdyn= ',istdyn 101 print*,'iadvtr= ',iadvtr 102 print*,'istphy= ',istphy 103 print*,'istdyn= ',istdyn 107 104 108 105 IF (iadvtr.eq.0) THEN … … 111 108 . rlon,rlat,dtime, dtime*istphy,dtime*istphy,nqmx,physid) 112 109 113 c write(*,*) 'apres initphysto ds phystokenc' 114 110 write(*,*) 'apres initphysto ds phystokenc' 111 112 ndex(1) = 0 113 i=itap 114 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d) 115 CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex) 116 c 117 i=itap 118 CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d) 119 CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex) 115 120 116 121 ENDIF 117 122 c 118 ndex2d = 0119 ndex3d = 0120 i=itap121 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)122 CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)123 c124 i=itap125 CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)126 CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)127 128 123 iadvtr=iadvtr+1 129 124 c 130 IF(mod(iadvtr,istphy).eq.0) THEN 125 c 126 c reinitialisation des champs cumules 127 if (mod(iadvtr,istphy).eq.1.or.istphy.eq.1) then 128 print*,'reinitialisation des champs cumules 129 s a iadvtr=',iadvtr 130 do k=1,klev 131 do i=1,klon 132 mfu(i,k)=0. 133 mfd(i,k)=0. 134 en_u(i,k)=0. 135 de_u(i,k)=0. 136 en_d(i,k)=0. 137 de_d(i,k)=0. 138 coefh(i,k)=0. 139 t(i,k)=0. 140 enddo 141 enddo 142 do i=1,klon 143 pyv1(i)=0. 144 pyu1(i)=0. 145 end do 146 do k=1,nbsrf 147 do i=1,klon 148 pftsol(i,k)=0. 149 ppsrf(i,k)=0. 150 enddo 151 enddo 152 153 dtcum=0. 154 endif 155 156 do k=1,klev 157 do i=1,klon 158 mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys 159 mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys 160 en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys 161 de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys 162 en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys 163 de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys 164 coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys 165 t(i,k)=t(i,k)+pt(i,k)*pdtphys 166 enddo 167 enddo 168 do i=1,klon 169 pyv1(i)=pyv1(i)+yv1(i)*pdtphys 170 pyu1(i)=pyu1(i)+yu1(i)*pdtphys 171 end do 172 do k=1,nbsrf 173 do i=1,klon 174 pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys 175 ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys 176 enddo 177 enddo 178 179 dtcum=dtcum+pdtphys 180 c 181 IF(mod(iadvtr,istphy).eq.0) THEN 131 182 c 132 183 c normalisation par le temps cumule … … 140 191 de_d(i,k)=de_d(i,k)/dtcum 141 192 coefh(i,k)=coefh(i,k)/dtcum 193 t(i,k)=t(i,k)/dtcum 142 194 enddo 143 195 enddo … … 146 198 pyu1(i)=pyu1(i)/dtcum 147 199 end do 148 do k=1,nbsrf200 c modif abderr 23 11 00 do k=1,nbsrf 149 201 do i=1,klon 202 do k=1,nbsrf 150 203 pftsol(i,k)=pftsol(i,k)/dtcum 204 ppsrf(i,k)=ppsrf(i,k)/dtcum 205 enddo 151 206 pftsol1(i) = pftsol(i,1) 152 207 pftsol2(i) = pftsol(i,2) … … 154 209 pftsol4(i) = pftsol(i,4) 155 210 156 ppsrf(i,k)=ppsrf(i,k)/dtcum211 c ppsrf(i,k)=ppsrf(i,k)/dtcum 157 212 ppsrf1(i) = ppsrf(i,1) 158 213 ppsrf2(i) = ppsrf(i,2) … … 161 216 162 217 enddo 163 enddo218 c enddo 164 219 c 165 220 c ecriture des champs … … 168 223 169 224 ccccc 225 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d) 226 CALL histwrite(physid,"t",itap,zx_tmp_3d, 227 . iim*(jjm+1)*klev,ndex) 228 170 229 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d) 171 230 CALL histwrite(physid,"mfu",itap,zx_tmp_3d, 172 . iim*(jjm+1)*klev,ndex 3d)173 231 . iim*(jjm+1)*klev,ndex) 232 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d) 174 233 CALL histwrite(physid,"mfd",itap,zx_tmp_3d, 175 . iim*(jjm+1)*klev,ndex 3d)234 . iim*(jjm+1)*klev,ndex) 176 235 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d) 177 236 CALL histwrite(physid,"en_u",itap,zx_tmp_3d, 178 . iim*(jjm+1)*klev,ndex 3d)237 . iim*(jjm+1)*klev,ndex) 179 238 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d) 180 239 CALL histwrite(physid,"de_u",itap,zx_tmp_3d, 181 . iim*(jjm+1)*klev,ndex 3d)240 . iim*(jjm+1)*klev,ndex) 182 241 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d) 183 242 CALL histwrite(physid,"en_d",itap,zx_tmp_3d, 184 . iim*(jjm+1)*klev,ndex 3d)185 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d) 186 CALL histwrite(physid,"de_d",itap,zx_tmp_3d, 187 . iim*(jjm+1)*klev,ndex 3d)188 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d) 189 CALL histwrite(physid,"coefh",itap,zx_tmp_3d, 190 . iim*(jjm+1)*klev,ndex 3d)243 . iim*(jjm+1)*klev,ndex) 244 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d) 245 CALL histwrite(physid,"de_d",itap,zx_tmp_3d, 246 . iim*(jjm+1)*klev,ndex) 247 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d) 248 CALL histwrite(physid,"coefh",itap,zx_tmp_3d, 249 . iim*(jjm+1)*klev,ndex) 191 250 cccc 192 251 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d) 193 252 CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d, 194 . iim*(jjm+1)*klev,ndex 3d)253 . iim*(jjm+1)*klev,ndex) 195 254 196 255 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d) 197 256 CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d, 198 . iim*(jjm+1)*klev,ndex 3d)199 257 . iim*(jjm+1)*klev,ndex) 258 200 259 CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d) 201 CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1), 202 . ndex2d) 203 204 CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d) 205 CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1) 206 . ,ndex2d) 207 208 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d) 260 CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1),ndex) 261 262 CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d) 263 CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1),ndex) 264 265 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d) 209 266 CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d, 210 . iim*(jjm+1),ndex 2d)267 . iim*(jjm+1),ndex) 211 268 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d) 212 269 CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d, 213 . iim*(jjm+1),ndex 2d)270 . iim*(jjm+1),ndex) 214 271 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d) 215 272 CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d, 216 . iim*(jjm+1),ndex2d) 273 . iim*(jjm+1),ndex) 274 275 c 217 276 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d) 218 277 CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d, 219 . iim*(jjm+1),ndex 2d)278 . iim*(jjm+1),ndex) 220 279 221 280 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d) 222 CALL histwrite(physid,"psrf1",itap,zx_tmp_2d, 223 . iim*(jjm+1),ndex 2d)281 CALL histwrite(physid,"psrf1",itap,zx_tmp_2d, 282 . iim*(jjm+1),ndex) 224 283 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d) 225 284 CALL histwrite(physid,"psrf2",itap,zx_tmp_2d, 226 . iim*(jjm+1),ndex 2d)285 . iim*(jjm+1),ndex) 227 286 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d) 228 287 CALL histwrite(physid,"psrf3",itap,zx_tmp_2d, 229 . iim*(jjm+1),ndex 2d)288 . iim*(jjm+1),ndex) 230 289 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d) 231 290 CALL histwrite(physid,"psrf4",itap,zx_tmp_2d, 232 . iim*(jjm+1),ndex2d) 233 234 if (ok_sync) call histsync(physid) 235 236 c 237 cAA Test sur la valeur des coefficients de lessivage 291 . iim*(jjm+1),ndex) 292 293 c 294 cAA Test sur la valeur des coefficients de lessivage 238 295 c 239 296 zmin=1e33 … … 257 314 Print*,'facteur d impaction ',zmin,zmax 258 315 259 ENDIF 260 261 c reinitialisation des champs cumules 262 if (mod(iadvtr,istphy).eq.1) then 263 do k=1,klev 264 do i=1,klon 265 mfu(i,k)=0. 266 mfd(i,k)=0. 267 en_u(i,k)=0. 268 de_u(i,k)=0. 269 en_d(i,k)=0. 270 de_d(i,k)=0. 271 coefh(i,k)=0. 272 enddo 273 enddo 274 do i=1,klon 275 pyv1(i)=0. 276 pyu1(i)=0. 277 end do 278 do k=1,nbsrf 279 do i=1,klon 280 pftsol(i,k)=0. 281 ppsrf(i,k)=0. 282 enddo 283 enddo 284 285 dtcum=0. 286 endif 287 288 do k=1,klev 289 do i=1,klon 290 mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys 291 mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys 292 en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys 293 de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys 294 en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys 295 de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys 296 coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys 297 enddo 298 enddo 299 do i=1,klon 300 pyv1(i)=pyv1(i)+yv1(i)*pdtphys 301 pyu1(i)=pyu1(i)+yu1(i)*pdtphys 302 end do 303 do k=1,nbsrf 304 do i=1,klon 305 pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys 306 ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys 307 enddo 308 enddo 309 310 dtcum=dtcum+pdtphys 316 ENDIF 317 311 318 312 319 RETURN
Note: See TracChangeset
for help on using the changeset viewer.
