| 1 | SUBROUTINE phystokenc (nlon,nlev,pdtphys,rlon,rlat, & |
|---|
| 2 | pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & |
|---|
| 3 | pfm_therm,pentr_therm, & |
|---|
| 4 | cdragh, pcoefh,yu1,yv1,ftsol,pctsrf, & |
|---|
| 5 | frac_impa,frac_nucl, & |
|---|
| 6 | pphis,paire,dtime,itap, & |
|---|
| 7 | psh, pda, pphi, pmp, pupwd, pdnwd) |
|---|
| 8 | |
|---|
| 9 | USE ioipsl |
|---|
| 10 | USE dimphy |
|---|
| 11 | USE infotrac, ONLY : nqtot |
|---|
| 12 | USE iophy |
|---|
| 13 | USE control_mod |
|---|
| 14 | |
|---|
| 15 | IMPLICIT NONE |
|---|
| 16 | |
|---|
| 17 | !====================================================================== |
|---|
| 18 | ! Auteur(s) FH |
|---|
| 19 | ! Objet: Ecriture des variables pour transport offline |
|---|
| 20 | ! |
|---|
| 21 | !====================================================================== |
|---|
| 22 | INCLUDE "dimensions.h" |
|---|
| 23 | INCLUDE "tracstoke.h" |
|---|
| 24 | INCLUDE "indicesol.h" |
|---|
| 25 | INCLUDE "iniprint.h" |
|---|
| 26 | !====================================================================== |
|---|
| 27 | |
|---|
| 28 | ! Arguments: |
|---|
| 29 | ! |
|---|
| 30 | REAL,DIMENSION(klon,klev), INTENT(IN) :: psh ! humidite specifique |
|---|
| 31 | REAL,DIMENSION(klon,klev), INTENT(IN) :: pda |
|---|
| 32 | REAL,DIMENSION(klon,klev,klev), INTENT(IN):: pphi |
|---|
| 33 | REAL,DIMENSION(klon,klev), INTENT(IN) :: pmp |
|---|
| 34 | REAL,DIMENSION(klon,klev), INTENT(IN) :: pupwd ! saturated updraft mass flux |
|---|
| 35 | REAL,DIMENSION(klon,klev), INTENT(IN) :: pdnwd ! saturated downdraft mass flux |
|---|
| 36 | |
|---|
| 37 | ! EN ENTREE: |
|---|
| 38 | ! ========== |
|---|
| 39 | ! |
|---|
| 40 | ! divers: |
|---|
| 41 | ! ------- |
|---|
| 42 | ! |
|---|
| 43 | INTEGER nlon ! nombre de points horizontaux |
|---|
| 44 | INTEGER nlev ! nombre de couches verticales |
|---|
| 45 | REAL pdtphys ! pas d'integration pour la physique (seconde) |
|---|
| 46 | INTEGER itap |
|---|
| 47 | INTEGER, SAVE :: physid |
|---|
| 48 | !$OMP THREADPRIVATE(physid) |
|---|
| 49 | |
|---|
| 50 | ! convection: |
|---|
| 51 | ! ----------- |
|---|
| 52 | ! |
|---|
| 53 | REAL pmfu(klon,klev) ! flux de masse dans le panache montant |
|---|
| 54 | REAL pmfd(klon,klev) ! flux de masse dans le panache descendant |
|---|
| 55 | REAL pen_u(klon,klev) ! flux entraine dans le panache montant |
|---|
| 56 | REAL pde_u(klon,klev) ! flux detraine dans le panache montant |
|---|
| 57 | REAL pen_d(klon,klev) ! flux entraine dans le panache descendant |
|---|
| 58 | REAL pde_d(klon,klev) ! flux detraine dans le panache descendant |
|---|
| 59 | REAL pt(klon,klev) |
|---|
| 60 | REAL,ALLOCATABLE,SAVE :: t(:,:) |
|---|
| 61 | !$OMP THREADPRIVATE(t) |
|---|
| 62 | ! |
|---|
| 63 | REAL rlon(klon), rlat(klon), dtime |
|---|
| 64 | REAL zx_tmp_3d(iim,jjm+1,klev),zx_tmp_2d(iim,jjm+1) |
|---|
| 65 | |
|---|
| 66 | ! Couche limite: |
|---|
| 67 | ! -------------- |
|---|
| 68 | ! |
|---|
| 69 | REAL cdragh(klon) ! cdrag |
|---|
| 70 | REAL pcoefh(klon,klev) ! coeff melange CL |
|---|
| 71 | REAL pcoefh_buf(klon,klev) ! coeff melange CL + cdrag |
|---|
| 72 | REAL yv1(klon) |
|---|
| 73 | REAL yu1(klon),pphis(klon),paire(klon) |
|---|
| 74 | |
|---|
| 75 | ! Les Thermiques : (Abderr 25 11 02) |
|---|
| 76 | ! --------------- |
|---|
| 77 | REAL, INTENT(IN) :: pfm_therm(klon,klev+1) |
|---|
| 78 | REAL pentr_therm(klon,klev) |
|---|
| 79 | |
|---|
| 80 | REAL,ALLOCATABLE,SAVE :: entr_therm(:,:) |
|---|
| 81 | REAL,ALLOCATABLE,SAVE :: fm_therm(:,:) |
|---|
| 82 | !$OMP THREADPRIVATE(entr_therm) |
|---|
| 83 | !$OMP THREADPRIVATE(fm_therm) |
|---|
| 84 | ! |
|---|
| 85 | ! Lessivage: |
|---|
| 86 | ! ---------- |
|---|
| 87 | ! |
|---|
| 88 | REAL frac_impa(klon,klev) |
|---|
| 89 | REAL frac_nucl(klon,klev) |
|---|
| 90 | ! |
|---|
| 91 | ! Arguments necessaires pour les sources et puits de traceur |
|---|
| 92 | ! |
|---|
| 93 | REAL ftsol(klon,nbsrf) ! Temperature du sol (surf)(Kelvin) |
|---|
| 94 | REAL pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol) |
|---|
| 95 | !====================================================================== |
|---|
| 96 | ! |
|---|
| 97 | INTEGER i, k, kk |
|---|
| 98 | REAL,ALLOCATABLE,SAVE :: mfu(:,:) ! flux de masse dans le panache montant |
|---|
| 99 | REAL,ALLOCATABLE,SAVE :: mfd(:,:) ! flux de masse dans le panache descendant |
|---|
| 100 | REAL,ALLOCATABLE,SAVE :: en_u(:,:) ! flux entraine dans le panache montant |
|---|
| 101 | REAL,ALLOCATABLE,SAVE :: de_u(:,:) ! flux detraine dans le panache montant |
|---|
| 102 | REAL,ALLOCATABLE,SAVE :: en_d(:,:) ! flux entraine dans le panache descendant |
|---|
| 103 | REAL,ALLOCATABLE,SAVE :: de_d(:,:) ! flux detraine dans le panache descendant |
|---|
| 104 | REAL,ALLOCATABLE,SAVE :: coefh(:,:) ! flux detraine dans le panache descendant |
|---|
| 105 | |
|---|
| 106 | REAL,ALLOCATABLE,SAVE :: pyu1(:) |
|---|
| 107 | REAL,ALLOCATABLE,SAVE :: pyv1(:) |
|---|
| 108 | REAL,ALLOCATABLE,SAVE :: pftsol(:,:) |
|---|
| 109 | REAL,ALLOCATABLE,SAVE :: ppsrf(:,:) |
|---|
| 110 | !$OMP THREADPRIVATE(mfu,mfd,en_u,de_u,en_d,de_d,coefh) |
|---|
| 111 | !$OMP THREADPRIVATE(pyu1,pyv1,pftsol,ppsrf) |
|---|
| 112 | |
|---|
| 113 | |
|---|
| 114 | REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: sh |
|---|
| 115 | REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: da |
|---|
| 116 | REAL,DIMENSION(:,:,:), ALLOCATABLE,SAVE :: phi |
|---|
| 117 | REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: mp |
|---|
| 118 | REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: upwd |
|---|
| 119 | REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: dnwd |
|---|
| 120 | |
|---|
| 121 | REAL, SAVE :: dtcum |
|---|
| 122 | INTEGER, SAVE:: iadvtr=0 |
|---|
| 123 | !$OMP THREADPRIVATE(dtcum,iadvtr) |
|---|
| 124 | REAL zmin,zmax |
|---|
| 125 | LOGICAL ok_sync |
|---|
| 126 | CHARACTER(len=12) :: nvar |
|---|
| 127 | ! |
|---|
| 128 | !====================================================================== |
|---|
| 129 | |
|---|
| 130 | iadvtr=iadvtr+1 |
|---|
| 131 | |
|---|
| 132 | ! Dans le meme vecteur on recombine le drag et les coeff d'echange |
|---|
| 133 | pcoefh_buf(:,1) = cdragh(:) |
|---|
| 134 | pcoefh_buf(:,2:klev) = pcoefh(:,2:klev) |
|---|
| 135 | |
|---|
| 136 | ok_sync = .TRUE. |
|---|
| 137 | |
|---|
| 138 | ! Initialization done only once |
|---|
| 139 | !====================================================================== |
|---|
| 140 | IF (iadvtr==1) THEN |
|---|
| 141 | ALLOCATE( t(klon,klev)) |
|---|
| 142 | ALLOCATE( mfu(klon,klev)) |
|---|
| 143 | ALLOCATE( mfd(klon,klev)) |
|---|
| 144 | ALLOCATE( en_u(klon,klev)) |
|---|
| 145 | ALLOCATE( de_u(klon,klev)) |
|---|
| 146 | ALLOCATE( en_d(klon,klev)) |
|---|
| 147 | ALLOCATE( de_d(klon,klev)) |
|---|
| 148 | ALLOCATE( coefh(klon,klev)) |
|---|
| 149 | ALLOCATE( entr_therm(klon,klev)) |
|---|
| 150 | ALLOCATE( fm_therm(klon,klev)) |
|---|
| 151 | ALLOCATE( pyu1(klon)) |
|---|
| 152 | ALLOCATE( pyv1(klon)) |
|---|
| 153 | ALLOCATE( pftsol(klon,nbsrf)) |
|---|
| 154 | ALLOCATE( ppsrf(klon,nbsrf)) |
|---|
| 155 | |
|---|
| 156 | ALLOCATE(sh(klon,klev)) |
|---|
| 157 | ALLOCATE(da(klon,klev)) |
|---|
| 158 | ALLOCATE(phi(klon,klev,klev)) |
|---|
| 159 | ALLOCATE(mp(klon,klev)) |
|---|
| 160 | ALLOCATE(upwd(klon,klev)) |
|---|
| 161 | ALLOCATE(dnwd(klon,klev)) |
|---|
| 162 | |
|---|
| 163 | CALL initphysto('phystoke', dtime, dtime*istphy,dtime*istphy,physid) |
|---|
| 164 | |
|---|
| 165 | ! Write field phis and aire only once |
|---|
| 166 | CALL histwrite_phy(physid,"phis",itap,pphis) |
|---|
| 167 | CALL histwrite_phy(physid,"aire",itap,paire) |
|---|
| 168 | CALL histwrite_phy(physid,"longitudes",itap,rlon) |
|---|
| 169 | CALL histwrite_phy(physid,"latitudes",itap,rlat) |
|---|
| 170 | |
|---|
| 171 | END IF |
|---|
| 172 | |
|---|
| 173 | |
|---|
| 174 | ! Set to zero cumulating fields |
|---|
| 175 | !====================================================================== |
|---|
| 176 | IF (MOD(iadvtr,istphy)==1.OR.istphy==1) THEN |
|---|
| 177 | WRITE(lunout,*)'reinitialisation des champs cumules a iadvtr=',iadvtr |
|---|
| 178 | mfu(:,:)=0. |
|---|
| 179 | mfd(:,:)=0. |
|---|
| 180 | en_u(:,:)=0. |
|---|
| 181 | de_u(:,:)=0. |
|---|
| 182 | en_d(:,:)=0. |
|---|
| 183 | de_d(:,:)=0. |
|---|
| 184 | coefh(:,:)=0. |
|---|
| 185 | t(:,:)=0. |
|---|
| 186 | fm_therm(:,:)=0. |
|---|
| 187 | entr_therm(:,:)=0. |
|---|
| 188 | pyv1(:)=0. |
|---|
| 189 | pyu1(:)=0. |
|---|
| 190 | pftsol(:,:)=0. |
|---|
| 191 | ppsrf(:,:)=0. |
|---|
| 192 | sh(:,:)=0. |
|---|
| 193 | da(:,:)=0. |
|---|
| 194 | phi(:,:,:)=0. |
|---|
| 195 | mp(:,:)=0. |
|---|
| 196 | upwd(:,:)=0. |
|---|
| 197 | dnwd(:,:)=0. |
|---|
| 198 | dtcum=0. |
|---|
| 199 | ENDIF |
|---|
| 200 | |
|---|
| 201 | |
|---|
| 202 | ! Cumulate fields at each time step |
|---|
| 203 | !====================================================================== |
|---|
| 204 | DO k=1,klev |
|---|
| 205 | DO i=1,klon |
|---|
| 206 | mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys |
|---|
| 207 | mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys |
|---|
| 208 | en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys |
|---|
| 209 | de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys |
|---|
| 210 | en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys |
|---|
| 211 | de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys |
|---|
| 212 | coefh(i,k)=coefh(i,k)+pcoefh_buf(i,k)*pdtphys |
|---|
| 213 | t(i,k)=t(i,k)+pt(i,k)*pdtphys |
|---|
| 214 | fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys |
|---|
| 215 | entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys |
|---|
| 216 | sh(i,k) = sh(i,k) + psh(i,k)*pdtphys |
|---|
| 217 | da(i,k) = da(i,k) + pda(i,k)*pdtphys |
|---|
| 218 | mp(i,k) = mp(i,k) + pmp(i,k)*pdtphys |
|---|
| 219 | upwd(i,k) = upwd(i,k) + pupwd(i,k)*pdtphys |
|---|
| 220 | dnwd(i,k) = dnwd(i,k) + pdnwd(i,k)*pdtphys |
|---|
| 221 | ENDDO |
|---|
| 222 | ENDDO |
|---|
| 223 | |
|---|
| 224 | DO kk=1,klev |
|---|
| 225 | DO k=1,klev |
|---|
| 226 | DO i=1,klon |
|---|
| 227 | phi(i,k,kk) = phi(i,k,kk) + pphi(i,k,kk)*pdtphys |
|---|
| 228 | END DO |
|---|
| 229 | END DO |
|---|
| 230 | END DO |
|---|
| 231 | |
|---|
| 232 | DO i=1,klon |
|---|
| 233 | pyv1(i)=pyv1(i)+yv1(i)*pdtphys |
|---|
| 234 | pyu1(i)=pyu1(i)+yu1(i)*pdtphys |
|---|
| 235 | END DO |
|---|
| 236 | DO k=1,nbsrf |
|---|
| 237 | DO i=1,klon |
|---|
| 238 | pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys |
|---|
| 239 | ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys |
|---|
| 240 | ENDDO |
|---|
| 241 | ENDDO |
|---|
| 242 | |
|---|
| 243 | ! Add time step to cumulated time |
|---|
| 244 | dtcum=dtcum+pdtphys |
|---|
| 245 | |
|---|
| 246 | |
|---|
| 247 | ! Write fields to file, if it is time to do so |
|---|
| 248 | !====================================================================== |
|---|
| 249 | IF(MOD(iadvtr,istphy)==0) THEN |
|---|
| 250 | |
|---|
| 251 | ! normalize with time period |
|---|
| 252 | DO k=1,klev |
|---|
| 253 | DO i=1,klon |
|---|
| 254 | mfu(i,k)=mfu(i,k)/dtcum |
|---|
| 255 | mfd(i,k)=mfd(i,k)/dtcum |
|---|
| 256 | en_u(i,k)=en_u(i,k)/dtcum |
|---|
| 257 | de_u(i,k)=de_u(i,k)/dtcum |
|---|
| 258 | en_d(i,k)=en_d(i,k)/dtcum |
|---|
| 259 | de_d(i,k)=de_d(i,k)/dtcum |
|---|
| 260 | coefh(i,k)=coefh(i,k)/dtcum |
|---|
| 261 | t(i,k)=t(i,k)/dtcum |
|---|
| 262 | fm_therm(i,k)=fm_therm(i,k)/dtcum |
|---|
| 263 | entr_therm(i,k)=entr_therm(i,k)/dtcum |
|---|
| 264 | sh(i,k)=sh(i,k)/dtcum |
|---|
| 265 | da(i,k)=da(i,k)/dtcum |
|---|
| 266 | mp(i,k)=mp(i,k)/dtcum |
|---|
| 267 | upwd(i,k)=upwd(i,k)/dtcum |
|---|
| 268 | dnwd(i,k)=dnwd(i,k)/dtcum |
|---|
| 269 | ENDDO |
|---|
| 270 | ENDDO |
|---|
| 271 | DO kk=1,klev |
|---|
| 272 | DO k=1,klev |
|---|
| 273 | DO i=1,klon |
|---|
| 274 | phi(i,k,kk) = phi(i,k,kk)/dtcum |
|---|
| 275 | END DO |
|---|
| 276 | END DO |
|---|
| 277 | END DO |
|---|
| 278 | DO i=1,klon |
|---|
| 279 | pyv1(i)=pyv1(i)/dtcum |
|---|
| 280 | pyu1(i)=pyu1(i)/dtcum |
|---|
| 281 | END DO |
|---|
| 282 | DO k=1,nbsrf |
|---|
| 283 | DO i=1,klon |
|---|
| 284 | pftsol(i,k)=pftsol(i,k)/dtcum |
|---|
| 285 | ppsrf(i,k)=ppsrf(i,k)/dtcum |
|---|
| 286 | ENDDO |
|---|
| 287 | ENDDO |
|---|
| 288 | |
|---|
| 289 | ! write fields |
|---|
| 290 | CALL histwrite_phy(physid,"t",itap,t) |
|---|
| 291 | CALL histwrite_phy(physid,"mfu",itap,mfu) |
|---|
| 292 | CALL histwrite_phy(physid,"mfd",itap,mfd) |
|---|
| 293 | CALL histwrite_phy(physid,"en_u",itap,en_u) |
|---|
| 294 | CALL histwrite_phy(physid,"de_u",itap,de_u) |
|---|
| 295 | CALL histwrite_phy(physid,"en_d",itap,en_d) |
|---|
| 296 | CALL histwrite_phy(physid,"de_d",itap,de_d) |
|---|
| 297 | CALL histwrite_phy(physid,"coefh",itap,coefh) |
|---|
| 298 | CALL histwrite_phy(physid,"fm_th",itap,fm_therm) |
|---|
| 299 | CALL histwrite_phy(physid,"en_th",itap,entr_therm) |
|---|
| 300 | CALL histwrite_phy(physid,"frac_impa",itap,frac_impa) |
|---|
| 301 | CALL histwrite_phy(physid,"frac_nucl",itap,frac_nucl) |
|---|
| 302 | CALL histwrite_phy(physid,"pyu1",itap,pyu1) |
|---|
| 303 | CALL histwrite_phy(physid,"pyv1",itap,pyv1) |
|---|
| 304 | CALL histwrite_phy(physid,"ftsol1",itap,pftsol(:,1)) |
|---|
| 305 | CALL histwrite_phy(physid,"ftsol2",itap,pftsol(:,2)) |
|---|
| 306 | CALL histwrite_phy(physid,"ftsol3",itap,pftsol(:,3)) |
|---|
| 307 | CALL histwrite_phy(physid,"ftsol4",itap,pftsol(:,4)) |
|---|
| 308 | CALL histwrite_phy(physid,"psrf1",itap,ppsrf(:,1)) |
|---|
| 309 | CALL histwrite_phy(physid,"psrf2",itap,ppsrf(:,2)) |
|---|
| 310 | CALL histwrite_phy(physid,"psrf3",itap,ppsrf(:,3)) |
|---|
| 311 | CALL histwrite_phy(physid,"psrf4",itap,ppsrf(:,4)) |
|---|
| 312 | CALL histwrite_phy(physid,"sh",itap,sh) |
|---|
| 313 | CALL histwrite_phy(physid,"da",itap,da) |
|---|
| 314 | CALL histwrite_phy(physid,"mp",itap,mp) |
|---|
| 315 | CALL histwrite_phy(physid,"upwd",itap,upwd) |
|---|
| 316 | CALL histwrite_phy(physid,"dnwd",itap,dnwd) |
|---|
| 317 | |
|---|
| 318 | |
|---|
| 319 | ! phi |
|---|
| 320 | DO k=1,klev |
|---|
| 321 | IF (k<10) THEN |
|---|
| 322 | WRITE(nvar,'(i1)') k |
|---|
| 323 | ELSE IF (k<100) THEN |
|---|
| 324 | WRITE(nvar,'(i2)') k |
|---|
| 325 | ELSE |
|---|
| 326 | WRITE(nvar,'(i3)') k |
|---|
| 327 | END IF |
|---|
| 328 | nvar='phi_lev'//trim(nvar) |
|---|
| 329 | |
|---|
| 330 | CALL histwrite_phy(physid,nvar,itap,phi(:,:,k)) |
|---|
| 331 | END DO |
|---|
| 332 | |
|---|
| 333 | ! Syncronize file |
|---|
| 334 | !$OMP MASTER |
|---|
| 335 | IF (ok_sync) CALL histsync(physid) |
|---|
| 336 | !$OMP END MASTER |
|---|
| 337 | |
|---|
| 338 | |
|---|
| 339 | ! Calculate min and max values for some fields (coefficients de lessivage) |
|---|
| 340 | zmin=1e33 |
|---|
| 341 | zmax=-1e33 |
|---|
| 342 | DO k=1,klev |
|---|
| 343 | DO i=1,klon |
|---|
| 344 | zmax=MAX(zmax,frac_nucl(i,k)) |
|---|
| 345 | zmin=MIN(zmin,frac_nucl(i,k)) |
|---|
| 346 | ENDDO |
|---|
| 347 | ENDDO |
|---|
| 348 | WRITE(lunout,*)'------ coefs de lessivage (min et max) --------' |
|---|
| 349 | WRITE(lunout,*)'facteur de nucleation ',zmin,zmax |
|---|
| 350 | zmin=1e33 |
|---|
| 351 | zmax=-1e33 |
|---|
| 352 | DO k=1,klev |
|---|
| 353 | DO i=1,klon |
|---|
| 354 | zmax=MAX(zmax,frac_impa(i,k)) |
|---|
| 355 | zmin=MIN(zmin,frac_impa(i,k)) |
|---|
| 356 | ENDDO |
|---|
| 357 | ENDDO |
|---|
| 358 | WRITE(lunout,*)'facteur d impaction ',zmin,zmax |
|---|
| 359 | |
|---|
| 360 | ENDIF ! IF(MOD(iadvtr,istphy)==0) |
|---|
| 361 | |
|---|
| 362 | END SUBROUTINE phystokenc |
|---|
