Changeset 2913 for trunk/LMDZ.MARS/libf/dynphy_lonlat
- Timestamp:
- Mar 14, 2023, 10:07:33 AM (22 months ago)
- Location:
- trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/ini_archive.F
r2573 r2913 1 1 c======================================================================= 2 subroutine ini_archive(nid,idayref,phis,ith,tab_cntrl_fi) 2 subroutine ini_archive(nid,idayref,phis,ith,tab_cntrl_fi 3 & ,def_slope,subslope_dist) 3 4 c======================================================================= 4 5 c … … 40 41 USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy 41 42 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 43 use comslope_mod, ONLY: nslope 42 44 implicit none 43 45 … … 66 68 REAL phis(ip1jmp1) 67 69 real ith(ip1jmp1,nsoilmx) 70 real subslope_dist(ip1jmp1,nslope) 71 real def_slope(nslope+1) 68 72 REAL tab_cntrl_fi(length) 69 73 … … 77 81 INTEGER idim_tim 78 82 INTEGER idim_nsoilmx ! "subsurface_layers" dimension ID # 83 INTEGER idim_nslope, idim_nslope_p1 79 84 INTEGER nid,nvarid 80 85 real sig_s(llm),s(llm) … … 163 168 ierr = NF_DEF_DIM (nid,"interlayer", llmp1, idim_llmp1) 164 169 ierr = NF_DEF_DIM (nid,"Time", NF_UNLIMITED, idim_tim) 170 ierr = NF_DEF_DIM (nid,"nslope", nslope, idim_nslope) 171 ierr = NF_DEF_DIM (nid,"nslope_plus_1",nslope+1,idim_nslope_p1) 165 172 166 173 c … … 513 520 #endif 514 521 522 c Put subslope dist 523 dims3(1)=idim_rlonv 524 dims3(2)=idim_rlatu 525 dims3(3)=idim_nslope 526 ierr = NF_REDEF (nid) 527 #ifdef NC_DOUBLE 528 ierr = NF_DEF_VAR (nid, "subslope_dist", NF_DOUBLE, 3, 529 . dims3,nvarid) 530 #else 531 ierr = NF_DEF_VAR (nid, "subslope_dist", NF_FLOAT, 3, 532 . dims3,nvarid) 533 #endif 534 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",13, 535 . "subslope_dist") 536 537 ierr = NF_ENDDEF(nid) 538 #ifdef NC_DOUBLE 539 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,subslope_dist) 540 #else 541 ierr = NF_PUT_VAR_REAL (nid,nvarid,subslope_dist) 542 #endif 543 544 c Put def_slope 545 546 ierr = NF_REDEF (nid) 547 #ifdef NC_DOUBLE 548 ierr = NF_DEF_VAR (nid, "def_slope", NF_DOUBLE, 1, 549 . [idim_nslope_p1],nvarid) 550 #else 551 ierr = NF_DEF_VAR (nid, "def_slope", NF_FLOAT, 1, 552 . [idim_nslope_p1],nvarid) 553 #endif 554 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",7,"def_slope") 555 ierr = NF_ENDDEF(nid) 556 #ifdef NC_DOUBLE 557 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,def_slope) 558 #else 559 ierr = NF_PUT_VAR_REAL (nid,nvarid,def_slope) 560 #endif 561 515 562 PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref 516 563 PRINT*,'rad,omeg,g,mugaz,kappa', -
trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/start2archive.F
r2828 r2913 33 33 USE phyetat0_mod, ONLY: phyetat0 34 34 USE exner_hyb_m, ONLY: exner_hyb 35 use comslope_mod, ONLY: nslope,def_slope,def_slope_mean, 36 & subslope_dist 37 USE comcstfi_h, only: pi 35 38 implicit none 36 39 … … 61 64 c Variable Physiques (grille physique) 62 65 c ------------------------------------ 63 REAL tsurf(ngridmx) ! Surface temperature64 REAL tsoil(ngridmx,nsoilmx) ! Soil temperature65 REAL watercap(ngridmx) ! h2o ice layer66 REAL tauscaling(ngridmx) ! dust conversion factor67 REAL totcloudfrac(ngridmx) ! sub-grid cloud fraction66 REAL,ALLOCATABLE :: tsurf(:,:) ! Surface temperature 67 REAL,ALLOCATABLE :: tsoil(:,:,:) ! Soil temperature 68 REAL,ALLOCATABLE :: watercap(:,:) ! h2o ice layer 69 REAL :: tauscaling(ngridmx) ! dust conversion factor 70 REAL:: totcloudfrac(ngridmx) ! sub-grid cloud fraction 68 71 REAL q2(ngridmx,llm+1) 69 REAL emis(ngridmx)70 REAL albedo(ngridmx,2)72 REAL,ALLOCATABLE :: emis(:,:) 73 REAL,ALLOCATABLE :: albedo(:,:,:) 71 74 REAL wstar(ngridmx) 72 75 INTEGER start,length … … 78 81 c ------------------------------------ 79 82 REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm) 80 REAL tsurfS(ip1jmp1)81 REAL tsoilS(ip1jmp1,nsoilmx)83 REAL,ALLOCATABLE :: tsurfS(:,:) 84 REAL,ALLOCATABLE :: tsoilS(:,:,:) 82 85 REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia 83 REAL watercapS(ip1jmp1)84 REAL tauscalingS(ip1jmp1)85 REAL totcloudfracS(ip1jmp1)86 REAL,ALLOCATABLE :: watercapS(:,:) 87 REAL :: tauscalingS(ip1jmp1) 88 REAL :: totcloudfracS(ip1jmp1) 86 89 REAL q2S(ip1jmp1,llm+1) 87 REAL,ALLOCATABLE :: qsurfS(:,:) 88 REAL emisS(ip1jmp1) 89 REAL albedoS(ip1jmp1) 90 REAL,ALLOCATABLE :: qsurfS(:,:,:) 91 REAL,ALLOCATABLE :: emisS(:,:) 92 REAL,ALLOCATABLE :: albedoS(:,:) 93 REAL, ALLOCATABLE :: subslope_distS(:,:) 90 94 91 95 c Variables intermediaires : vent naturel, mais pas coord scalaire … … 106 110 data fichier /'startfi'/ 107 111 108 INTEGER ij, l,i,j,isoil,iq 112 INTEGER ij, l,i,j,isoil,iq,islope 109 113 character*80 fichnom 110 114 integer :: ierr,ntime … … 133 137 134 138 ! allocate arrays: 135 allocate(q(ip1jmp1,llm,nqtot)) 136 allocate(qsurfS(ip1jmp1,nqtot)) 137 139 allocate(q(ip1jmp1,llm,nqtot)) 138 140 139 141 fichnom = 'start.nc' … … 161 163 Lmodif=0 162 164 165 allocate(tsurf(ngridmx,nslope)) 166 allocate(tsoil(ngridmx,nsoilmx,nslope)) 167 allocate(watercap(ngridmx,nslope)) 168 allocate(emis(ngridmx,nslope)) 169 allocate(albedo(ngridmx,2,nslope)) 170 171 allocate(qsurfS(ip1jmp1,nqtot,nslope)) 172 allocate(tsurfS(ip1jmp1,nslope)) 173 allocate(tsoilS(ip1jmp1,nsoilmx,nslope)) 174 allocate(watercapS(ip1jmp1,nslope)) 175 allocate(emisS(ip1jmp1,nslope)) 176 allocate(albedoS(ip1jmp1,nslope)) 177 allocate(subslope_distS(ip1jmp1,nslope)) 178 163 179 CALL phyetat0 (fichnom,0,Lmodif,nsoilmx,ngridmx,llm,nqtot, 164 180 & day_ini_fi,timefi,tsurf,tsoil,albedo,emis,q2,qsurf, 165 & tauscaling,totcloudfrac,wstar,watercap) 181 & tauscaling,totcloudfrac,wstar,watercap,def_slope, 182 & def_slope_mean,subslope_dist) 166 183 167 184 ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1) … … 257 274 c----------------------------------------------------------------------- 258 275 259 call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS) 260 call gr_fi_dyn(1,ngridmx,iip1,jjp1,watercap,watercapS) 261 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS) 276 do islope=1,nslope 277 call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf(:,islope), 278 & tsurfS(:,islope)) 279 call gr_fi_dyn(1,ngridmx,iip1,jjp1,watercap(:,islope), 280 & watercapS(:,islope)) 281 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil(:,:,islope), 282 & tsoilS(:,:,islope)) 262 283 ! Note: thermal inertia "inertiedat" is in comsoil.h 284 call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis(:,islope), 285 & emisS(:,islope)) 286 call gr_fi_dyn(1,ngridmx,iip1,jjp1,albedo(:,1,islope), 287 & albedoS(:,islope)) 288 call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf(:,:,islope), 289 & qsurfS(:,:,islope)) 290 call gr_fi_dyn(1,ngridmx,iip1,jjp1,subslope_dist(:,islope), 291 & subslope_distS(:,islope)) 292 enddo 263 293 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS) 264 call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)265 call gr_fi_dyn(1,ngridmx,iip1,jjp1,albedo(:,1),albedoS)266 294 call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S) 267 call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS)268 295 call gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscalingS) 269 296 call gr_fi_dyn(1,ngridmx,iip1,jjp1,totcloudfrac,totcloudfracS) … … 283 310 DO j=1,jjp1 284 311 DO i=1,iim 312 DO islope=1,nslope 285 313 ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g 286 314 co2icetotal = co2icetotal + 287 & qsurfS(i+(iim+1)*(j-1),igcm_co2)*aire(i+(iim+1)*(j-1)) 315 & qsurfS(i+(iim+1)*(j-1),igcm_co2,islope)* 316 & aire(i+(iim+1)*(j-1))* 317 & subslope_distS(i+(iim+1)*(j-1),islope)/ 318 & cos(pi*def_slope_mean(islope)) 319 ENDDO 288 320 ENDDO 289 321 ENDDO … … 324 356 ierr = NF_CREATE('start_archive.nc', 325 357 & IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid) 326 call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi) 358 call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi, 359 & def_slope,subslope_distS) 327 360 endif 328 361 … … 398 431 txt=trim(tname(iq))//"_surf" 399 432 call write_archive(nid,ntime,txt,'Tracer on surface', 400 & 'kg.m-2',2,qsurfS( 1,iq))433 & 'kg.m-2',2,qsurfS(:,iq,:)) 401 434 enddo 402 435 … … 417 450 ! Write soil temperatures tsoil 418 451 call write_archive(nid,ntime,'tsoil','Soil temperature', 419 & 'K',-3,tsoilS )452 & 'K',-3,tsoilS(:,:,:)) 420 453 421 454 ! Write soil thermal inertia -
trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/write_archive.F
r1422 r2913 33 33 34 34 use comsoil_h, only: nsoilmx 35 use comslope_mod, ONLY: nslope 35 36 implicit none 36 37 … … 58 59 59 60 c local 60 integer, dimension( 4) :: edges,corner,id61 integer, dimension(5) :: edges,corner,id 61 62 integer :: varid,i,j,l 62 63 c----------------------------------------------------------------------- … … 124 125 ! get variables' ID, if it exists 125 126 ierr=NF_INQ_VARID(nid,nom,varid) 127 128 if(nom.eq."tsoil") then 129 130 if (ierr.ne.NF_NOERR) then ! variable not defined yet 131 ! build related coordinates 132 ierr=NF_INQ_DIMID(nid,"longitude",id(1)) 133 ierr=NF_INQ_DIMID(nid,"latitude",id(2)) 134 ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3)) 135 if (ierr.ne.NF_NOERR) then 136 write(*,*)"write_archive: dimension <subsurface_layers>", 137 & " is missing !!!" 138 call abort 139 endif 140 ierr=NF_INQ_DIMID(nid,"nslope",id(4)) 141 if (ierr.ne.NF_NOERR) then 142 write(*,*)"write_archive: dimension <nslope>", 143 & " is missing !!!" 144 call abort 145 endif 146 ierr=NF_INQ_DIMID(nid,"Time",id(5)) 147 148 ! define the variable 149 write(*,*)"=====================" 150 write(*,*)"defining ",nom 151 call def_var(nid,nom,titre,unite,5,id,varid,ierr) 152 153 endif 154 155 ! build cedges and corners 156 corner(1)=1 157 corner(2)=1 158 corner(3)=1 159 corner(4)=1 160 corner(5)=ntime 161 162 edges(1)=iip1 163 edges(2)=jjp1 164 edges(3)=nsoilmx 165 edges(4)=nslope 166 edges(5)=1 167 168 #ifdef NC_DOUBLE 169 ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px) 170 #else 171 ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px) 172 #endif 173 174 else 126 175 127 176 if (ierr.ne.NF_NOERR) then ! variable not defined yet … … 160 209 #endif 161 210 211 endif 212 162 213 163 214 ! For a surface 2D Variable … … 169 220 170 221 ierr= NF_INQ_VARID(nid,nom,varid) 222 223 if(nom.eq."tauscaling" .or. nom.eq."totcloudfrac" .or. 224 & nom.eq."ps" .or. nom.eq."q2surf") then 225 171 226 if (ierr /= NF_NOERR) then 172 227 ! choix du nom des coordonnees … … 203 258 call abort 204 259 endif 260 261 else 262 263 if (ierr /= NF_NOERR) then 264 ! choix du nom des coordonnees 265 ierr= NF_INQ_DIMID(nid,"longitude",id(1)) 266 ierr= NF_INQ_DIMID(nid,"latitude",id(2)) 267 ierr= NF_INQ_DIMID(nid,"nslope",id(3)) 268 ierr= NF_INQ_DIMID(nid,"Time",id(4)) 269 270 ! Creation de la variable si elle n'existait pas 271 272 write (*,*) "=====================" 273 write (*,*) "creation de ",nom 274 275 call def_var(nid,nom,titre,unite,4,id,varid,ierr) 276 277 endif 278 279 corner(1)=1 280 corner(2)=1 281 corner(3)=1 282 corner(4)=ntime 283 284 edges(1)=iip1 285 edges(2)=jjp1 286 edges(3)=nslope 287 edges(4)=1 288 289 290 #ifdef NC_DOUBLE 291 ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px) 292 #else 293 ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px) 294 #endif 295 296 if (ierr.ne.NF_NOERR) then 297 write(*,*) "***** PUT_VAR matter in write_archive" 298 write(*,*) "***** with ",nom,nf_STRERROR(ierr) 299 call abort 300 endif 301 302 endif 205 303 206 304
Note: See TracChangeset
for help on using the changeset viewer.