Changeset 704 for LMDZ4/branches/V3_test/libf/phylmd/phystokenc.F
- Timestamp:
- Aug 17, 2006, 5:41:51 PM (18 years ago)
- File:
-
- 1 edited
-
LMDZ4/branches/V3_test/libf/phylmd/phystokenc.F (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/V3_test/libf/phylmd/phystokenc.F
r541 r704 12 12 I pphis,paire,dtime,itap) 13 13 USE ioipsl 14 USE histcom15 14 USE dimphy 15 USE iophy 16 16 IMPLICIT none 17 17 … … 23 23 c====================================================================== 24 24 #include "dimensions.h" 25 #include "dimphy.h"25 cym#include "dimphy.h" 26 26 #include "tracstoke.h" 27 27 #include "indicesol.h" … … 43 43 integer physid, itap 44 44 save physid 45 c$OMP THREADPRIVATE(physid) 45 46 integer ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev) 46 47 … … 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(:,:) 59 c$OMP THREADPRIVATE(t) 57 60 c 58 61 REAL rlon(klon), rlat(klon), dtime … … 69 72 c --------------- 70 73 REAL pfm_therm(klon,klev+1) 71 74 real fm_therm1(klon,klev) 72 75 REAL pentr_therm(klon,klev) 73 REAL entr_therm(klon,klev) 74 REAL fm_therm(klon,klev) 76 77 REAL,allocatable,save :: entr_therm(:,:) 78 REAL,allocatable,save :: fm_therm(:,:) 79 c$OMP THREADPRIVATE(entr_therm) 80 c$OMP THREADPRIVATE(fm_therm) 75 81 c 76 82 c Lessivage: … … 88 94 INTEGER i, k 89 95 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) 96 REAL,allocatable,save :: mfu(:,:) ! flux de masse dans le panache montant 97 REAL,allocatable,save :: mfd(:,:) ! flux de masse dans le panache descendant 98 REAL,allocatable,save :: en_u(:,:) ! flux entraine dans le panache montant 99 REAL,allocatable,save :: de_u(:,:) ! flux detraine dans le panache montant 100 REAL,allocatable,save :: en_d(:,:) ! flux entraine dans le panache descendant 101 REAL,allocatable,save :: de_d(:,:) ! flux detraine dans le panache descendant 102 REAL,allocatable,save :: coefh(:,:) ! flux detraine dans le panache descendant 103 104 REAL,allocatable,save :: pyu1(:) 105 REAL,allocatable,save :: pyv1(:) 106 REAL,allocatable,save :: pftsol(:,:) 107 REAL,allocatable,save :: ppsrf(:,:) 108 c$OMP THREADPRIVATE(mfu,mfd,en_u,de_u,en_d,de_d,coefh) 109 c$OMP THREADPRIVATE(pyu1,pyv1,pftsol,ppsrf) 100 110 real pftsol1(klon),pftsol2(klon),pftsol3(klon),pftsol4(klon) 101 111 real ppsrf1(klon),ppsrf2(klon),ppsrf3(klon),ppsrf4(klon) … … 107 117 logical ok_sync 108 118 109 save t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum 110 save fm_therm,entr_therm 119 save dtcum 111 120 save iadvtr,irec 112 save pyu1,pyv1,pftsol,ppsrf 113 121 c$OMP THREADPRIVATE(dtcum,iadvtr,irec) 114 122 data iadvtr,irec/0,1/ 123 logical,save :: first=.true. 124 c$OMP THREADPRIVATE(first) 115 125 c 116 126 c Couche limite: … … 123 133 print*,'istdyn= ',istdyn 124 134 135 if (first) then 136 137 allocate( t(klon,klev)) 138 allocate( mfu(klon,klev)) 139 allocate( mfd(klon,klev)) 140 allocate( en_u(klon,klev)) 141 allocate( de_u(klon,klev)) 142 allocate( en_d(klon,klev)) 143 allocate( de_d(klon,klev)) 144 allocate( coefh(klon,klev)) 145 allocate( entr_therm(klon,klev)) 146 allocate( fm_therm(klon,klev)) 147 allocate( pyu1(klon)) 148 allocate( pyv1(klon)) 149 allocate( pftsol(klon,nbsrf)) 150 allocate( ppsrf(klon,nbsrf)) 151 152 first=.false. 153 endif 154 125 155 IF (iadvtr.eq.0) THEN 126 156 … … 136 166 ndex3d = 0 137 167 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)168 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d) 169 CALL histwrite_phy(physid,"phis",i,pphis) 140 170 c 141 171 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)172 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d) 173 CALL histwrite_phy(physid,"aire",i,paire) 144 174 145 175 iadvtr=iadvtr+1 … … 247 277 248 278 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) 279 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d) 280 CALL histwrite_phy(physid,"t",itap,t) 281 282 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d) 283 CALL histwrite_phy(physid,"mfu",itap,mfu) 284 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d) 285 CALL histwrite_phy(physid,"mfd",itap,mfd) 286 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d) 287 CALL histwrite_phy(physid,"en_u",itap,en_u) 288 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d) 289 CALL histwrite_phy(physid,"de_u",itap,de_u) 290 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d) 291 CALL histwrite_phy(physid,"en_d",itap,en_d) 292 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d) 293 CALL histwrite_phy(physid,"de_d",itap,de_d) 294 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d) 295 CALL histwrite_phy(physid,"coefh",itap,coefh) 274 296 275 297 c ajou... … … 280 302 enddo 281 303 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) 304 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, fm_therm1, zx_tmp_3d) 305 CALL histwrite_phy(physid,"fm_th",itap,fm_therm1) 306 c 307 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, entr_therm, zx_tmp_3d) 308 CALL histwrite_phy(physid,"en_th",itap,entr_therm) 289 309 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) 310 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d) 311 CALL histwrite_phy(physid,"frac_impa",itap,frac_impa) 312 313 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d) 314 CALL histwrite_phy(physid,"frac_nucl",itap,frac_nucl) 297 315 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) 316 cym CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d) 317 CALL histwrite_phy(physid,"pyu1",itap,pyu1) 301 318 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) 319 cym CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d) 320 CALL histwrite_phy(physid,"pyv1",itap,pyv1) 305 321 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) 331 322 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d) 323 CALL histwrite_phy(physid,"ftsol1",itap,pftsol1) 324 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d) 325 CALL histwrite_phy(physid,"ftsol2",itap,pftsol2) 326 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d) 327 CALL histwrite_phy(physid,"ftsol3",itap,pftsol3) 328 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d) 329 CALL histwrite_phy(physid,"ftsol4",itap,pftsol4) 330 331 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d) 332 CALL histwrite_phy(physid,"psrf1",itap,ppsrf1) 333 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d) 334 CALL histwrite_phy(physid,"psrf2",itap,ppsrf2) 335 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d) 336 CALL histwrite_phy(physid,"psrf3",itap,ppsrf3) 337 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d) 338 CALL histwrite_phy(physid,"psrf4",itap,ppsrf4) 339 340 c$OMP MASTER 332 341 if (ok_sync) call histsync(physid) 342 c$OMP END MASTER 333 343 c if (ok_sync) call histsync 334 344
Note: See TracChangeset
for help on using the changeset viewer.
