Changeset 634 for LMDZ4/branches/LMDZ4_par_0/libf/phylmd/phystokenc.F
- Timestamp:
- May 4, 2005, 5:11:29 PM (19 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4_par_0/libf/phylmd/phystokenc.F
r633 r634 13 13 USE ioipsl 14 14 USE histcom 15 15 USE dimphy 16 USE iophy 16 17 IMPLICIT none 17 18 … … 23 24 c====================================================================== 24 25 #include "dimensions.h" 25 #include "dimphy.h"26 cym#include "dimphy.h" 26 27 #include "tracstoke.h" 27 28 #include "indicesol.h" … … 54 55 REAL pen_d(klon,klev) ! flux entraine dans le panache descendant 55 56 REAL pde_d(klon,klev) ! flux detraine dans le panache descendant 56 real pt(klon,klev),t(klon,klev) 57 real pt(klon,klev) 58 REAL,allocatable,save :: t(:,:) 57 59 c 58 60 REAL rlon(klon), rlat(klon), dtime … … 71 73 real fm_therm1(klon,klev) 72 74 REAL pentr_therm(klon,klev) 73 REAL entr_therm(klon,klev) 74 REAL fm_therm(klon,klev) 75 76 REAL,allocatable,save :: entr_therm(:,:) 77 REAL,allocatable,save :: fm_therm(:,:) 75 78 c 76 79 c Lessivage: … … 88 91 INTEGER i, k 89 92 c 90 REAL mfu(klon,klev) ! flux de masse dans le panache montant 91 REAL mfd(klon,klev) ! flux de masse dans le panache descendant 92 REAL en_u(klon,klev) ! flux entraine dans le panache montant 93 REAL de_u(klon,klev) ! flux detraine dans le panache montant 94 REAL en_d(klon,klev) ! flux entraine dans le panache descendant 95 REAL de_d(klon,klev) ! flux detraine dans le panache descendant 96 REAL coefh(klon,klev) ! flux detraine dans le panache descendant 97 98 REAL pyu1(klon),pyv1(klon) 99 REAL pftsol(klon,nbsrf),ppsrf(klon,nbsrf) 93 REAL,allocatable,save :: mfu(:,:) ! flux de masse dans le panache montant 94 REAL,allocatable,save :: mfd(:,:) ! flux de masse dans le panache descendant 95 REAL,allocatable,save :: en_u(:,:) ! flux entraine dans le panache montant 96 REAL,allocatable,save :: de_u(:,:) ! flux detraine dans le panache montant 97 REAL,allocatable,save :: en_d(:,:) ! flux entraine dans le panache descendant 98 REAL,allocatable,save :: de_d(:,:) ! flux detraine dans le panache descendant 99 REAL,allocatable,save :: coefh(:,:) ! flux detraine dans le panache descendant 100 101 REAL,allocatable,save :: pyu1(:) 102 REAL,allocatable,save :: pyv1(:) 103 REAL,allocatable,save :: pftsol(:,:) 104 REAL,allocatable,save :: ppsrf(:,:) 105 100 106 real pftsol1(klon),pftsol2(klon),pftsol3(klon),pftsol4(klon) 101 107 real ppsrf1(klon),ppsrf2(klon),ppsrf3(klon),ppsrf4(klon) … … 107 113 logical ok_sync 108 114 109 save t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum 110 save fm_therm,entr_therm 115 save dtcum 111 116 save iadvtr,irec 112 save pyu1,pyv1,pftsol,ppsrf113 117 114 118 data iadvtr,irec/0,1/ 119 logical,save :: first=.true. 115 120 c 116 121 c Couche limite: … … 123 128 print*,'istdyn= ',istdyn 124 129 130 if (first) then 131 132 allocate( t(klon,klev)) 133 allocate( mfu(klon,klev)) 134 allocate( mfd(klon,klev)) 135 allocate( en_u(klon,klev)) 136 allocate( de_u(klon,klev)) 137 allocate( en_d(klon,klev)) 138 allocate( de_d(klon,klev)) 139 allocate( coefh(klon,klev)) 140 allocate( entr_therm(klon,klev)) 141 allocate( fm_therm(klon,klev)) 142 allocate( pyu1(klon)) 143 allocate( pyv1(klon)) 144 allocate( pftsol(klon,nbsrf)) 145 allocate( ppsrf(klon,nbsrf)) 146 147 first=.false. 148 endif 149 125 150 IF (iadvtr.eq.0) THEN 126 151 … … 136 161 ndex3d = 0 137 162 i=itap 138 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)139 CALL histwrite (physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)163 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d) 164 CALL histwrite_phy(physid,"phis",i,pphis) 140 165 c 141 166 i=itap 142 CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)143 CALL histwrite (physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)167 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d) 168 CALL histwrite_phy(physid,"aire",i,paire) 144 169 145 170 iadvtr=iadvtr+1 … … 247 272 248 273 ccccc 249 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d) 250 CALL histwrite(physid,"t",itap,zx_tmp_3d, 251 . iim*(jjm+1)*klev,ndex3d) 252 253 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d) 254 CALL histwrite(physid,"mfu",itap,zx_tmp_3d, 255 . iim*(jjm+1)*klev,ndex3d) 256 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d) 257 CALL histwrite(physid,"mfd",itap,zx_tmp_3d, 258 . iim*(jjm+1)*klev,ndex3d) 259 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d) 260 CALL histwrite(physid,"en_u",itap,zx_tmp_3d, 261 . iim*(jjm+1)*klev,ndex3d) 262 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d) 263 CALL histwrite(physid,"de_u",itap,zx_tmp_3d, 264 . iim*(jjm+1)*klev,ndex3d) 265 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d) 266 CALL histwrite(physid,"en_d",itap,zx_tmp_3d, 267 . iim*(jjm+1)*klev,ndex3d) 268 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d) 269 CALL histwrite(physid,"de_d",itap,zx_tmp_3d, 270 . iim*(jjm+1)*klev,ndex3d) 271 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d) 272 CALL histwrite(physid,"coefh",itap,zx_tmp_3d, 273 . iim*(jjm+1)*klev,ndex3d) 274 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d) 275 CALL histwrite_phy(physid,"t",itap,t) 276 277 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d) 278 CALL histwrite_phy(physid,"mfu",itap,mfu) 279 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d) 280 CALL histwrite_phy(physid,"mfd",itap,mfd) 281 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d) 282 CALL histwrite_phy(physid,"en_u",itap,en_u) 283 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d) 284 CALL histwrite_phy(physid,"de_u",itap,de_u) 285 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d) 286 CALL histwrite_phy(physid,"en_d",itap,en_d) 287 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d) 288 CALL histwrite_phy(physid,"de_d",itap,de_d) 289 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d) 290 CALL histwrite_phy(physid,"coefh",itap,coefh) 274 291 275 292 c ajou... … … 280 297 enddo 281 298 282 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, fm_therm1, zx_tmp_3d) 283 CALL histwrite(physid,"fm_th",itap,zx_tmp_3d, 284 . iim*(jjm+1)*klev,ndex3d) 285 c 286 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, entr_therm, zx_tmp_3d) 287 CALL histwrite(physid,"en_th",itap,zx_tmp_3d, 288 . iim*(jjm+1)*klev,ndex3d) 299 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, fm_therm1, zx_tmp_3d) 300 CALL histwrite_phy(physid,"fm_th",itap,fm_therm1) 301 c 302 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, entr_therm, zx_tmp_3d) 303 CALL histwrite_phy(physid,"en_th",itap,entr_therm) 289 304 cccc 290 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d) 291 CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d, 292 . iim*(jjm+1)*klev,ndex3d) 293 294 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d) 295 CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d, 296 . iim*(jjm+1)*klev,ndex3d) 305 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d) 306 CALL histwrite_phy(physid,"frac_impa",itap,frac_impa) 307 308 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d) 309 CALL histwrite_phy(physid,"frac_nucl",itap,frac_nucl) 297 310 298 CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d) 299 CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1), 300 . ndex2d) 311 cym CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d) 312 CALL histwrite_phy(physid,"pyu1",itap,pyu1) 301 313 302 CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d) 303 CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1) 304 . ,ndex2d) 314 cym CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d) 315 CALL histwrite_phy(physid,"pyv1",itap,pyv1) 305 316 306 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d) 307 CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d, 308 . iim*(jjm+1),ndex2d) 309 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d) 310 CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d, 311 . iim*(jjm+1),ndex2d) 312 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d) 313 CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d, 314 . iim*(jjm+1),ndex2d) 315 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d) 316 CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d, 317 . iim*(jjm+1),ndex2d) 318 319 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d) 320 CALL histwrite(physid,"psrf1",itap,zx_tmp_2d, 321 . iim*(jjm+1),ndex2d) 322 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d) 323 CALL histwrite(physid,"psrf2",itap,zx_tmp_2d, 324 . iim*(jjm+1),ndex2d) 325 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d) 326 CALL histwrite(physid,"psrf3",itap,zx_tmp_2d, 327 . iim*(jjm+1),ndex2d) 328 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d) 329 CALL histwrite(physid,"psrf4",itap,zx_tmp_2d, 330 . iim*(jjm+1),ndex2d) 317 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d) 318 CALL histwrite_phy(physid,"ftsol1",itap,pftsol1) 319 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d) 320 CALL histwrite_phy(physid,"ftsol2",itap,pftsol2) 321 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d) 322 CALL histwrite_phy(physid,"ftsol3",itap,pftsol3) 323 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d) 324 CALL histwrite_phy(physid,"ftsol4",itap,pftsol4) 325 326 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d) 327 CALL histwrite_phy(physid,"psrf1",itap,ppsrf1) 328 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d) 329 CALL histwrite_phy(physid,"psrf2",itap,ppsrf2) 330 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d) 331 CALL histwrite_phy(physid,"psrf3",itap,ppsrf3) 332 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d) 333 CALL histwrite_phy(physid,"psrf4",itap,ppsrf4) 331 334 332 335 if (ok_sync) call histsync(physid)
Note: See TracChangeset
for help on using the changeset viewer.