[52] | 1 | SUBROUTINE phystokenc ( |
---|
| 2 | I nlon,nlev,pdtphys,rlon,rlat, |
---|
| 3 | I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, |
---|
| 4 | I pcoefh,yu1,yv1,ftsol,pctsrf, |
---|
| 5 | I frac_impa,frac_nucl, |
---|
| 6 | I pphis,paire,dtime,itap, |
---|
| 7 | O physid) |
---|
| 8 | USE ioipsl |
---|
[177] | 9 | USE histcom |
---|
[52] | 10 | |
---|
| 11 | IMPLICIT none |
---|
| 12 | |
---|
| 13 | c====================================================================== |
---|
| 14 | c Auteur(s) FH |
---|
| 15 | c Objet: Moniteur general des tendances traceurs |
---|
| 16 | c |
---|
| 17 | |
---|
| 18 | c====================================================================== |
---|
| 19 | #include "dimensions.h" |
---|
| 20 | #include "dimphy.h" |
---|
| 21 | #include "tracstoke.h" |
---|
| 22 | #include "indicesol.h" |
---|
| 23 | #include "control.h" |
---|
| 24 | c====================================================================== |
---|
| 25 | |
---|
| 26 | c Arguments: |
---|
| 27 | c |
---|
| 28 | c EN ENTREE: |
---|
| 29 | c ========== |
---|
| 30 | c |
---|
| 31 | c divers: |
---|
| 32 | c ------- |
---|
| 33 | c |
---|
| 34 | integer nlon ! nombre de points horizontaux |
---|
| 35 | integer nlev ! nombre de couches verticales |
---|
| 36 | real pdtphys ! pas d'integration pour la physique (seconde) |
---|
| 37 | c |
---|
| 38 | integer physid, itap |
---|
| 39 | integer ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev) |
---|
| 40 | |
---|
| 41 | c convection: |
---|
| 42 | c ----------- |
---|
| 43 | c |
---|
| 44 | REAL pmfu(klon,klev) ! flux de masse dans le panache montant |
---|
| 45 | REAL pmfd(klon,klev) ! flux de masse dans le panache descendant |
---|
| 46 | REAL pen_u(klon,klev) ! flux entraine dans le panache montant |
---|
| 47 | REAL pde_u(klon,klev) ! flux detraine dans le panache montant |
---|
| 48 | REAL pen_d(klon,klev) ! flux entraine dans le panache descendant |
---|
| 49 | REAL pde_d(klon,klev) ! flux detraine dans le panache descendant |
---|
| 50 | c |
---|
| 51 | REAL rlon(klon), rlat(klon), dtime |
---|
| 52 | REAL zx_tmp_3d(iim,jjm+1,klev),zx_tmp_2d(iim,jjm+1) |
---|
| 53 | |
---|
| 54 | c Couche limite: |
---|
| 55 | c -------------- |
---|
| 56 | c |
---|
| 57 | REAL pcoefh(klon,klev) ! coeff melange CL |
---|
| 58 | REAL yv1(klon) |
---|
| 59 | REAL yu1(klon),pphis(klon),paire(klon) |
---|
| 60 | c |
---|
| 61 | c Lessivage: |
---|
| 62 | c ---------- |
---|
| 63 | c |
---|
| 64 | REAL frac_impa(klon,klev) |
---|
| 65 | REAL frac_nucl(klon,klev) |
---|
| 66 | c |
---|
| 67 | c Arguments necessaires pour les sources et puits de traceur |
---|
| 68 | C |
---|
| 69 | real ftsol(klon,nbsrf) ! Temperature du sol (surf)(Kelvin) |
---|
| 70 | real pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol) |
---|
| 71 | c====================================================================== |
---|
| 72 | c |
---|
| 73 | INTEGER i, k |
---|
| 74 | c |
---|
| 75 | REAL mfu(klon,klev) ! flux de masse dans le panache montant |
---|
| 76 | REAL mfd(klon,klev) ! flux de masse dans le panache descendant |
---|
| 77 | REAL en_u(klon,klev) ! flux entraine dans le panache montant |
---|
| 78 | REAL de_u(klon,klev) ! flux detraine dans le panache montant |
---|
| 79 | REAL en_d(klon,klev) ! flux entraine dans le panache descendant |
---|
| 80 | REAL de_d(klon,klev) ! flux detraine dans le panache descendant |
---|
| 81 | REAL coefh(klon,klev) ! flux detraine dans le panache descendant |
---|
| 82 | |
---|
| 83 | REAL pyu1(klon),pyv1(klon) |
---|
| 84 | REAL pftsol(klon,nbsrf),ppsrf(klon,nbsrf) |
---|
| 85 | real pftsol1(klon),pftsol2(klon),pftsol3(klon),pftsol4(klon) |
---|
| 86 | real ppsrf1(klon),ppsrf2(klon),ppsrf3(klon),ppsrf4(klon) |
---|
| 87 | |
---|
| 88 | REAL dtcum |
---|
| 89 | |
---|
| 90 | integer iadvtr,irec |
---|
| 91 | real zmin,zmax |
---|
| 92 | logical ok_sync |
---|
| 93 | |
---|
| 94 | save mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum |
---|
| 95 | save iadvtr,irec |
---|
| 96 | save pyu1,pyv1,pftsol,ppsrf |
---|
| 97 | |
---|
| 98 | data iadvtr,irec/0,1/ |
---|
| 99 | c |
---|
| 100 | c Couche limite: |
---|
| 101 | c====================================================================== |
---|
| 102 | |
---|
| 103 | ok_sync = .true. |
---|
| 104 | |
---|
| 105 | c print*,'iadvtr= ',iadvtr |
---|
| 106 | c print*,'istphy= ',istphy |
---|
| 107 | c print*,'istdyn= ',istdyn |
---|
| 108 | |
---|
| 109 | IF (iadvtr.eq.0) THEN |
---|
| 110 | |
---|
| 111 | CALL initphysto('phystoke', |
---|
| 112 | . rlon,rlat,dtime, dtime*istphy,dtime*istphy,nqmx,physid) |
---|
| 113 | |
---|
| 114 | c write(*,*) 'apres initphysto ds phystokenc' |
---|
| 115 | |
---|
| 116 | |
---|
| 117 | ENDIF |
---|
| 118 | c |
---|
| 119 | ndex2d = 0 |
---|
| 120 | ndex3d = 0 |
---|
| 121 | i=itap |
---|
| 122 | CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d) |
---|
| 123 | CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d) |
---|
| 124 | c |
---|
| 125 | i=itap |
---|
| 126 | CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d) |
---|
| 127 | CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d) |
---|
| 128 | |
---|
| 129 | iadvtr=iadvtr+1 |
---|
| 130 | c |
---|
| 131 | IF(mod(iadvtr,istphy).eq.0) THEN |
---|
| 132 | c |
---|
| 133 | c normalisation par le temps cumule |
---|
| 134 | do k=1,klev |
---|
| 135 | do i=1,klon |
---|
| 136 | mfu(i,k)=mfu(i,k)/dtcum |
---|
| 137 | mfd(i,k)=mfd(i,k)/dtcum |
---|
| 138 | en_u(i,k)=en_u(i,k)/dtcum |
---|
| 139 | de_u(i,k)=de_u(i,k)/dtcum |
---|
| 140 | en_d(i,k)=en_d(i,k)/dtcum |
---|
| 141 | de_d(i,k)=de_d(i,k)/dtcum |
---|
| 142 | coefh(i,k)=coefh(i,k)/dtcum |
---|
| 143 | enddo |
---|
| 144 | enddo |
---|
| 145 | do i=1,klon |
---|
| 146 | pyv1(i)=pyv1(i)/dtcum |
---|
| 147 | pyu1(i)=pyu1(i)/dtcum |
---|
| 148 | end do |
---|
| 149 | do k=1,nbsrf |
---|
| 150 | do i=1,klon |
---|
| 151 | pftsol(i,k)=pftsol(i,k)/dtcum |
---|
| 152 | pftsol1(i) = pftsol(i,1) |
---|
| 153 | pftsol2(i) = pftsol(i,2) |
---|
| 154 | pftsol3(i) = pftsol(i,3) |
---|
| 155 | pftsol4(i) = pftsol(i,4) |
---|
| 156 | |
---|
| 157 | ppsrf(i,k)=ppsrf(i,k)/dtcum |
---|
| 158 | ppsrf1(i) = ppsrf(i,1) |
---|
| 159 | ppsrf2(i) = ppsrf(i,2) |
---|
| 160 | ppsrf3(i) = ppsrf(i,3) |
---|
| 161 | ppsrf4(i) = ppsrf(i,4) |
---|
| 162 | |
---|
| 163 | enddo |
---|
| 164 | enddo |
---|
| 165 | c |
---|
| 166 | c ecriture des champs |
---|
| 167 | c |
---|
| 168 | irec=irec+1 |
---|
| 169 | |
---|
| 170 | ccccc |
---|
| 171 | CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d) |
---|
| 172 | CALL histwrite(physid,"mfu",itap,zx_tmp_3d, |
---|
| 173 | . iim*(jjm+1)*klev,ndex3d) |
---|
| 174 | CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d) |
---|
| 175 | CALL histwrite(physid,"mfd",itap,zx_tmp_3d, |
---|
| 176 | . iim*(jjm+1)*klev,ndex3d) |
---|
| 177 | CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d) |
---|
| 178 | CALL histwrite(physid,"en_u",itap,zx_tmp_3d, |
---|
| 179 | . iim*(jjm+1)*klev,ndex3d) |
---|
| 180 | CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d) |
---|
| 181 | CALL histwrite(physid,"de_u",itap,zx_tmp_3d, |
---|
| 182 | . iim*(jjm+1)*klev,ndex3d) |
---|
| 183 | CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d) |
---|
| 184 | CALL histwrite(physid,"en_d",itap,zx_tmp_3d, |
---|
| 185 | . iim*(jjm+1)*klev,ndex3d) |
---|
| 186 | CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d) |
---|
| 187 | CALL histwrite(physid,"de_d",itap,zx_tmp_3d, |
---|
| 188 | . iim*(jjm+1)*klev,ndex3d) |
---|
| 189 | CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d) |
---|
| 190 | CALL histwrite(physid,"coefh",itap,zx_tmp_3d, |
---|
| 191 | . iim*(jjm+1)*klev,ndex3d) |
---|
| 192 | cccc |
---|
| 193 | CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d) |
---|
| 194 | CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d, |
---|
| 195 | . iim*(jjm+1)*klev,ndex3d) |
---|
| 196 | |
---|
| 197 | CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d) |
---|
| 198 | CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d, |
---|
| 199 | . iim*(jjm+1)*klev,ndex3d) |
---|
| 200 | |
---|
| 201 | CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d) |
---|
| 202 | CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1), |
---|
| 203 | . ndex2d) |
---|
| 204 | |
---|
| 205 | CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d) |
---|
| 206 | CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1) |
---|
| 207 | . ,ndex2d) |
---|
| 208 | |
---|
| 209 | CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d) |
---|
| 210 | CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d, |
---|
| 211 | . iim*(jjm+1),ndex2d) |
---|
| 212 | CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d) |
---|
| 213 | CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d, |
---|
| 214 | . iim*(jjm+1),ndex2d) |
---|
| 215 | CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d) |
---|
| 216 | CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d, |
---|
| 217 | . iim*(jjm+1),ndex2d) |
---|
| 218 | CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d) |
---|
| 219 | CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d, |
---|
| 220 | . iim*(jjm+1),ndex2d) |
---|
| 221 | |
---|
| 222 | CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d) |
---|
| 223 | CALL histwrite(physid,"psrf1",itap,zx_tmp_2d, |
---|
| 224 | . iim*(jjm+1),ndex2d) |
---|
| 225 | CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d) |
---|
| 226 | CALL histwrite(physid,"psrf2",itap,zx_tmp_2d, |
---|
| 227 | . iim*(jjm+1),ndex2d) |
---|
| 228 | CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d) |
---|
| 229 | CALL histwrite(physid,"psrf3",itap,zx_tmp_2d, |
---|
| 230 | . iim*(jjm+1),ndex2d) |
---|
| 231 | CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d) |
---|
| 232 | CALL histwrite(physid,"psrf4",itap,zx_tmp_2d, |
---|
| 233 | . iim*(jjm+1),ndex2d) |
---|
| 234 | |
---|
| 235 | if (ok_sync) call histsync(physid) |
---|
| 236 | |
---|
| 237 | c |
---|
| 238 | cAA Test sur la valeur des coefficients de lessivage |
---|
| 239 | c |
---|
| 240 | zmin=1e33 |
---|
| 241 | zmax=-1e33 |
---|
| 242 | do k=1,klev |
---|
| 243 | do i=1,klon |
---|
| 244 | zmax=max(zmax,frac_nucl(i,k)) |
---|
| 245 | zmin=min(zmin,frac_nucl(i,k)) |
---|
| 246 | enddo |
---|
| 247 | enddo |
---|
| 248 | Print*,'------ coefs de lessivage (min et max) --------' |
---|
| 249 | Print*,'facteur de nucleation ',zmin,zmax |
---|
| 250 | zmin=1e33 |
---|
| 251 | zmax=-1e33 |
---|
| 252 | do k=1,klev |
---|
| 253 | do i=1,klon |
---|
| 254 | zmax=max(zmax,frac_impa(i,k)) |
---|
| 255 | zmin=min(zmin,frac_impa(i,k)) |
---|
| 256 | enddo |
---|
| 257 | enddo |
---|
| 258 | Print*,'facteur d impaction ',zmin,zmax |
---|
| 259 | |
---|
| 260 | ENDIF |
---|
| 261 | |
---|
| 262 | c reinitialisation des champs cumules |
---|
| 263 | if (mod(iadvtr,istphy).eq.1) then |
---|
| 264 | do k=1,klev |
---|
| 265 | do i=1,klon |
---|
| 266 | mfu(i,k)=0. |
---|
| 267 | mfd(i,k)=0. |
---|
| 268 | en_u(i,k)=0. |
---|
| 269 | de_u(i,k)=0. |
---|
| 270 | en_d(i,k)=0. |
---|
| 271 | de_d(i,k)=0. |
---|
| 272 | coefh(i,k)=0. |
---|
| 273 | enddo |
---|
| 274 | enddo |
---|
| 275 | do i=1,klon |
---|
| 276 | pyv1(i)=0. |
---|
| 277 | pyu1(i)=0. |
---|
| 278 | end do |
---|
| 279 | do k=1,nbsrf |
---|
| 280 | do i=1,klon |
---|
| 281 | pftsol(i,k)=0. |
---|
| 282 | ppsrf(i,k)=0. |
---|
| 283 | enddo |
---|
| 284 | enddo |
---|
| 285 | |
---|
| 286 | dtcum=0. |
---|
| 287 | endif |
---|
| 288 | |
---|
| 289 | do k=1,klev |
---|
| 290 | do i=1,klon |
---|
| 291 | mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys |
---|
| 292 | mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys |
---|
| 293 | en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys |
---|
| 294 | de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys |
---|
| 295 | en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys |
---|
| 296 | de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys |
---|
| 297 | coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys |
---|
| 298 | enddo |
---|
| 299 | enddo |
---|
| 300 | do i=1,klon |
---|
| 301 | pyv1(i)=pyv1(i)+yv1(i)*pdtphys |
---|
| 302 | pyu1(i)=pyu1(i)+yu1(i)*pdtphys |
---|
| 303 | end do |
---|
| 304 | do k=1,nbsrf |
---|
| 305 | do i=1,klon |
---|
| 306 | pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys |
---|
| 307 | ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys |
---|
| 308 | enddo |
---|
| 309 | enddo |
---|
| 310 | |
---|
| 311 | dtcum=dtcum+pdtphys |
---|
| 312 | |
---|
| 313 | RETURN |
---|
| 314 | END |
---|