Changeset 1871 for trunk/LMDZ.TITAN/libf
- Timestamp:
- Dec 20, 2017, 12:23:42 PM (7 years ago)
- Location:
- trunk/LMDZ.TITAN/libf
- Files:
-
- 1 added
- 5 edited
-
dynphy_lonlat/phytitan/newstart.F (modified) (7 diffs)
-
dynphy_lonlat/phytitan/start2archive.F (modified) (10 diffs)
-
dynphy_lonlat/phytitan/write_archive.F (modified) (5 diffs)
-
phytitan/comchem_h.F90 (added)
-
phytitan/iostart.F90 (modified) (5 diffs)
-
phytitan/tabfi_mod.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/newstart.F
r1850 r1871 6 6 c Auteur: Christophe Hourdin/Francois Forget/Yann Wanherdrick 7 7 c ------ 8 c Derniere modif : 12/03 9 c 10 c 11 c Objet: Create or modify the initial state for the LMD Mars GCM 8 c 9 c Objet: Create or modify the initial state for the LMD Titan GCM 12 10 c ----- (fichiers NetCDF start et startfi) 13 11 c … … 568 566 write(*,*) 'flat : no topography ("aquaplanet")' 569 567 write(*,*) 'set_ps_to_preff : used if changing preff with topo' 570 write(*,*) 'nuketharsis : no Tharsis bulge'571 568 write(*,*) 'bilball : uniform albedo and thermal inertia' 572 write(*,*) 'coldspole : cold subsurface and high albedo at S.pole'573 569 write(*,*) 'qname : change tracer name' 574 570 write(*,*) 't=profile : read temperature profile in profile.in' … … 582 578 ! write(*,*) 'ini_q-iceH2O : tracers initialisation for chemistry on 583 579 ! $ly ' 584 write(*,*) 'noglacier : Remove tropical H2O ice if |lat|<45'585 write(*,*) 'watercapn : H20 ice on permanent N polar cap '586 write(*,*) 'watercaps : H20 ice on permanent S polar cap '587 write(*,*) 'noacglac : H2O ice across Noachis Terra'588 write(*,*) 'oborealis : H2O ice across Vastitas Borealis'589 write(*,*) 'iceball : Thick ice layer all over surface'590 write(*,*) 'supercontinent: Create a continent of given Ab and TI'591 write(*,*) 'wetstart : start with a wet atmosphere'592 580 write(*,*) 'isotherm : Isothermal Temperatures, wind set to zero' 593 581 write(*,*) 'radequi : Earth-like radiative equilibrium temperature 594 582 $ profile (lat-alt) and winds set to zero' 595 write(*,*) 'coldstart : Start X K above the CO2 frost point and596 $set wind to zero (assumes 100% CO2)'597 write(*,*) 'co2ice=0 : remove CO2 polar cap'598 583 write(*,*) 'ptot : change total pressure' 599 584 write(*,*) 'emis : change surface emissivity' … … 664 649 enddo 665 650 666 c 'nuketharsis : no tharsis bulge for Early Mars'667 c ---------------------------------------------668 else if (trim(modif) .eq. 'nuketharsis') then669 670 DO j=1,jjp1671 DO i=1,iim672 ig=1+(j-2)*iim +i673 if(j.eq.1) ig=1674 if(j.eq.jjp1) ig=ngridmx675 676 fact1=(((rlonv(i)*180./pi)+100)**2 +677 & (rlatu(j)*180./pi)**2)/65**2678 fact2=exp( -fact1**2.5 )679 680 phis(i,j) = phis(i,j) - (phis(i,j)+4000.*g)*fact2681 682 ! if(phis(i,j).gt.2500.*g)then683 ! if(rlatu(j)*180./pi.gt.-80.)then ! avoid chopping south polar cap684 ! phis(i,j)=2500.*g685 ! endif686 ! endif687 688 ENDDO689 ENDDO690 CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)691 692 651 693 652 c bilball : uniform albedo, thermal inertia … … 717 676 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi) 718 677 CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi) 719 720 c coldspole : sous-sol de la calotte sud toujours froid721 c -----------------------------------------------------722 else if (trim(modif) .eq. 'coldspole') then723 write(*,*)'new value for the subsurface temperature',724 & ' beneath the permanent southern polar cap ? (eg: 141 K)'725 103 read(*,*,iostat=ierr) tsud726 if(ierr.ne.0) goto 103727 write(*,*)728 write(*,*) ' new value of the subsurface temperature:',tsud729 c nouvelle temperature sous la calotte permanente730 do l=2,nsoilmx731 tsoil(ngridmx,l) = tsud732 end do733 734 735 write(*,*)'new value for the albedo',736 & 'of the permanent southern polar cap ? (eg: 0.75)'737 104 read(*,*,iostat=ierr) albsud738 if(ierr.ne.0) goto 104739 write(*,*)740 741 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~742 c Option 1: only the albedo of the pole is modified :743 albfi(ngridmx)=albsud744 write(*,*) 'ig=',ngridmx,' albedo perennial cap ',745 & albfi(ngridmx)746 747 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~748 c Option 2 A haute resolution : coordonnee de la vrai calotte ~749 c DO j=1,jjp1750 c DO i=1,iip1751 c ig=1+(j-2)*iim +i752 c if(j.eq.1) ig=1753 c if(j.eq.jjp1) ig=ngridmx754 c if ((rlatu(j)*180./pi.lt.-84.).and.755 c & (rlatu(j)*180./pi.gt.-91.).and.756 c & (rlonv(i)*180./pi.gt.-91.).and.757 c & (rlonv(i)*180./pi.lt.0.)) then758 cc albedo de la calotte permanente fixe a albsud759 c alb(i,j)=albsud760 c write(*,*) 'lat=',rlatu(j)*180./pi,761 c & ' lon=',rlonv(i)*180./pi762 cc fin de la condition sur les limites de la calotte permanente763 c end if764 c ENDDO765 c ENDDO766 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~767 768 c CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)769 770 678 771 679 c ptot : Modification of the total pressure: ice + current atmosphere … … 1024 932 1025 933 1026 c wetstart : wet atmosphere with a north to south gradient1027 c --------------------------------------------------------1028 else if (trim(modif) .eq. 'wetstart') then1029 ! check that there is indeed a water vapor tracer1030 1031 write(*,*) "No water vapour tracer! Can't use this option"1032 stop1033 1034 c noglacier : remove tropical water ice (to initialize high res sim)1035 c --------------------------------------------------1036 else if (trim(modif) .eq. 'noglacier') then1037 1038 write(*,*) "No water ice tracer! Can't use this option"1039 stop1040 1041 1042 1043 c watercapn : H20 ice on permanent northern cap1044 c --------------------------------------------------1045 else if (trim(modif) .eq. 'watercapn') then1046 1047 write(*,*) "No water ice tracer! Can't use this option"1048 stop1049 1050 c watercaps : H20 ice on permanent southern cap1051 c -------------------------------------------------1052 else if (trim(modif) .eq. 'watercaps') then1053 1054 write(*,*) "No water ice tracer! Can't use this option"1055 stop1056 1057 c noacglac : H2O ice across highest terrain1058 c --------------------------------------------1059 else if (trim(modif) .eq. 'noacglac') then1060 1061 write(*,*) "No water ice tracer! Can't use this option"1062 stop1063 1064 c oborealis : H2O oceans across Vastitas Borealis1065 c -----------------------------------------------1066 else if (trim(modif) .eq. 'oborealis') then1067 1068 write(*,*) "No water ice tracer! Can't use this option"1069 stop1070 1071 c iborealis : H2O ice in Northern plains1072 c --------------------------------------1073 else if (trim(modif) .eq. 'iborealis') then1074 1075 write(*,*) "No water ice tracer! Can't use this option"1076 stop1077 1078 c oceanball : H2O liquid everywhere1079 c ----------------------------1080 else if (trim(modif) .eq. 'oceanball') then1081 1082 write(*,*) "No water ice tracer! Can't use this option"1083 stop1084 1085 c iceball : H2O ice everywhere1086 c ----------------------------1087 else if (trim(modif) .eq. 'iceball') then1088 1089 write(*,*) "No water ice tracer! Can't use this option"1090 stop1091 1092 c supercontinent : H2O ice everywhere1093 c ----------------------------1094 else if (trim(modif) .eq. 'supercontinent') then1095 1096 write(*,*) "No water ice tracer! Can't use this option"1097 stop1098 1099 934 c isotherm : Isothermal temperatures and no winds 1100 935 c ----------------------------------------------- … … 1153 988 q2(1:ngridmx,1:llm+1)=0 1154 989 1155 c coldstart : T set 1K above CO2 frost point and no winds1156 c ------------------------------------------------1157 else if (trim(modif) .eq. 'coldstart') then1158 1159 write(*,*)'set temperature of the atmosphere,'1160 &,'surface and subsurface how many degrees above CO2 frost point?'1161 204 read(*,*,iostat=ierr) Tabove1162 if(ierr.ne.0) goto 2041163 1164 DO j=1,jjp11165 DO i=1,iim1166 ig=1+(j-2)*iim +i1167 if(j.eq.1) ig=11168 if(j.eq.jjp1) ig=ngridmx1169 tsurf(ig) = (-3167.8)/(log(.01*ps(i,j))-23.23)+Tabove1170 END DO1171 END DO1172 do l=1,nsoilmx1173 do ig=1, ngridmx1174 tsoil(ig,l) = tsurf(ig)1175 end do1176 end do1177 DO j=1,jjp11178 DO i=1,iim1179 Do l=1,llm1180 pp = aps(l) +bps(l)*ps(i,j)1181 Tset(i,j,l)=(-3167.8)/(log(.01*pp)-23.23)+Tabove1182 end do1183 end do1184 end do1185 1186 flagtset=.true.1187 ucov(1:iip1,1:jjp1,1:llm)=01188 vcov(1:iip1,1:jjm,1:llm)=01189 q2(1:ngridmx,1:llm+1)=01190 1191 1192 c co2ice=0 : remove CO2 polar ice caps'1193 c ------------------------------------------------1194 else if (trim(modif) .eq. 'co2ice=0') then1195 write(*,*) "Can't remove CO2 ice!! (no co2_ice tracer)"1196 1197 1198 990 ! therm_ini_s: (re)-set soil thermal inertia to reference surface values 1199 991 ! ---------------------------------------------------------------------- -
trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/start2archive.F
r1815 r1871 21 21 use infotrac, only: infotrac_init, nqtot, tname 22 22 USE comsoil_h 23 23 USE comchem_h 24 24 25 ! USE comgeomfi_h, ONLY: lati, long, area 25 26 ! use control_mod … … 81 82 INTEGER*4 day_ini_fi 82 83 83 ! added by JVO for methane surface tank 84 REAL tankCH4(ngridmx) 84 c Added by JVO for Titan specifities 85 REAL tankCH4(ngridmx) ! Depth of surface methane tank 86 87 ! + Titan upper atm. chemistry 44 fields in comchem_h 85 88 86 89 c Variable naturelle / grille scalaire … … 94 97 REAL emisS(ip1jmp1) 95 98 96 ! added by JVO for methane surface tank 97 REAL tankCH4S(ip1jmp1) 98 99 c Added by JVO for Titan specifities 100 REAL tankCH4S(ip1jmp1) ! Depth of surface methane tank 101 102 ! + Titan upper atm. chemistry 44 fields in comchem_h 103 99 104 c Variables intermediaires : vent naturel, mais pas coord scalaire 100 105 c---------------------------------------------------------------- … … 105 110 LOGICAL startdrs 106 111 INTEGER Lmodif 112 113 LOGICAL nokim 107 114 108 115 REAL ptotal … … 192 199 CALL abort 193 200 ENDIF 194 ierr = NF_CLOSE(nid1)195 201 196 202 ! allocate arrays of nsoilmx size … … 198 204 allocate(tsoilS(ip1jmp1,nsoilmx)) 199 205 allocate(ithS(ip1jmp1,nsoilmx)) 206 207 ! Get value of the "upper_chemistry_layers" dimension from physics start file 208 209 ierr = NF_INQ_DIMID(nid1,"upper_chemistry_layers",varid) 210 IF (ierr .NE. NF_NOERR) THEN 211 PRINT*, "start2archive: No upper_chemistry_layers dimension!!" 212 CALL abort 213 ENDIF 214 ierr = NF_INQ_DIMLEN(nid1,varid,nlaykim_up) 215 IF (ierr .NE. NF_NOERR) THEN 216 PRINT*, "start2archive: Failed reading 217 . upper_chemistry_layers value!!" 218 CALL abort 219 ENDIF 220 221 ! Allocate arrays of nlaykim_up size, only if they're present 222 ! The test is on HCN but could be on any as we assume we can't do incomplete chemistry 223 224 ierr = NF_INQ_VARID(nid1,'HCN_up',varid) 225 IF (ierr .NE. NF_NOERR) THEN 226 PRINT*, "start2archive: Missing field(s) for upper chemistry ... 227 . I presume they're all absent !" 228 nokim=.TRUE. 229 ELSE 230 PRINT*,"start2archive: I found a field for upper chemistry ... 231 . I presume they're all here as you can't do uncomplete chemistry!" 232 ! Allocates upper chemistry fields in comchem_h on physical and scalar grid 233 CALL allokim_start2archive(ngridmx,ip1jmp1) 234 ENDIF 235 236 ierr = NF_CLOSE(nid1) 200 237 201 238 c----------------------------------------------------------------------- … … 316 353 c qsurf --> qsurfS 317 354 c tankCH4 --> tankCH4S 355 c + all 44 chemistry fields 318 356 c 319 357 c----------------------------------------------------------------------- … … 327 365 call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS) 328 366 call gr_fi_dyn(1,ngridmx,iip1,jjp1,tankCH4,tankCH4S) 367 368 IF (nokim .eqv. .FALSE.) THEN ! NB : fields are in comchem_h 369 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,H,H_S) 370 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,H2,H2_S) 371 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH,CH_S) 372 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH2s,CH2s_S) 373 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH2,CH2_S) 374 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH3,CH3_S) 375 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH4,CH4_S) 376 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2,C2_S) 377 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2H,C2H_S) 378 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2H2,C2H2_S) 379 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2H3,C2H3_S) 380 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2H4,C2H4_S) 381 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2H5,C2H5_S) 382 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2H6,C2H6_S) 383 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3H3,C3H3_S) 384 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3H5,C3H5_S) 385 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3H6,C3H6_S) 386 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3H7,C3H7_S) 387 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H,C4H_S) 388 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H3,C4H3_S) 389 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H4,C4H4_S) 390 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H2s,C4H2s_S) 391 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH2CCH2,CH2CCH2_S) 392 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH3CCH,CH3CCH_S) 393 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3H8,C3H8_S) 394 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H2,C4H2_S) 395 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H6,C4H6_S) 396 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H10,C4H10_S) 397 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,AC6H6,AC6H6_S) 398 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3H2,C3H2_S) 399 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H5,C4H5_S) 400 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,AC6H5,AC6H5_S) 401 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,N2,N2_S) 402 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,N4S,N4S_S) 403 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CN,CN_S) 404 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,HCN,HCN_S) 405 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,H2CN,H2CN_S) 406 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CHCN,CHCN_S) 407 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH2CN,CH2CN_S) 408 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH3CN,CH3CN_S) 409 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3N,C3N_S) 410 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,HC3N,HC3N_S) 411 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,NCCN,NCCN_S) 412 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4N2,C4N2_S) 413 ENDIF 329 414 330 415 c======================================================================= … … 400 485 401 486 c----------------------------------------------------------------------- 402 c Ecriture des champs (emis,ps,Tsurf,T,u,v,q2,q,qsurf )487 c Ecriture des champs (emis,ps,Tsurf,T,u,v,q2,q,qsurf,tankCH4) 403 488 c----------------------------------------------------------------------- 404 489 c ATTENTION: q2 a une couche de plus!!!! … … 471 556 & 'Depth of surface methane tank','m',2,tankCH4S) 472 557 558 c----------------------------------------------------------------- 559 c Ecriture des champs upper_chemistry 560 c----------------------------------------------------------------- 561 562 IF (nokim .eqv. .FALSE.) THEN 563 call write_archive(nid,ntime,'H_up', 564 . 'H in upper atmosphere','kg/kg',4,H_S) 565 call write_archive(nid,ntime,'H2_up', 566 . 'H2 in upper atmosphere','kg/kg',4,H2_S) 567 call write_archive(nid,ntime,'CH_up', 568 . 'CH in upper atmosphere','kg/kg',4,CH_S) 569 call write_archive(nid,ntime,'CH2s_up', 570 . 'CH2s in upper atmosphere','kg/kg',4,CH2s_S) 571 call write_archive(nid,ntime,'CH2_up', 572 . 'CH2 in upper atmosphere','kg/kg',4,CH2_S) 573 call write_archive(nid,ntime,'CH3_up', 574 . 'CH3 in upper atmosphere','kg/kg',4,CH3_S) 575 call write_archive(nid,ntime,'CH4_up', 576 . 'CH4 in upper atmosphere','kg/kg',4,CH4_S) 577 call write_archive(nid,ntime,'C2_up', 578 . 'C2 in upper atmosphere','kg/kg',4,C2_S) 579 call write_archive(nid,ntime,'C2H_up', 580 . 'C2H in upper atmosphere','kg/kg',4,C2H_S) 581 call write_archive(nid,ntime,'C2H2_up', 582 . 'C2H2 in upper atmosphere','kg/kg',4,C2H2_S) 583 call write_archive(nid,ntime,'C2H3_up', 584 . 'C2H3 in upper atmosphere','kg/kg',4,C2H3_S) 585 call write_archive(nid,ntime,'C2H4_up', 586 . 'C2H4 in upper atmosphere','kg/kg',4,C2H4_S) 587 call write_archive(nid,ntime,'C2H5_up', 588 . 'C2H5 in upper atmosphere','kg/kg',4,C2H5_S) 589 call write_archive(nid,ntime,'C2H6_up', 590 . 'C2H6 in upper atmosphere','kg/kg',4,C2H6_S) 591 call write_archive(nid,ntime,'C3H3_up', 592 . 'C3H3 in upper atmosphere','kg/kg',4,C3H3_S) 593 call write_archive(nid,ntime,'C3H5_up', 594 . 'C3H5 in upper atmosphere','kg/kg',4,C3H5_S) 595 call write_archive(nid,ntime,'C3H6_up', 596 . 'C3H6 in upper atmosphere','kg/kg',4,C3H6_S) 597 call write_archive(nid,ntime,'C3H7_up', 598 . 'C3H7 in upper atmosphere','kg/kg',4,C3H7_S) 599 call write_archive(nid,ntime,'C4H_up', 600 . 'C4H in upper atmosphere','kg/kg',4,C4H_S) 601 call write_archive(nid,ntime,'C4H3_up', 602 . 'C4H3 in upper atmosphere','kg/kg',4,C4H3_S) 603 call write_archive(nid,ntime,'C4H4_up', 604 . 'C4H4 in upper atmosphere','kg/kg',4,C4H4_S) 605 call write_archive(nid,ntime,'C4H2s_up', 606 . 'C4H2s in upper atmosphere','kg/kg',4,C4H2s_S) 607 call write_archive(nid,ntime,'CH2CCH2_up', 608 . 'CH2CCH2 in upper atmosphere','kg/kg',4,CH2CCH2_S) 609 call write_archive(nid,ntime,'CH3CCH_up', 610 . 'CH3CCH in upper atmosphere','kg/kg',4,CH3CCH_S) 611 call write_archive(nid,ntime,'C3H8_up', 612 . 'C3H8 in upper atmosphere','kg/kg',4,C3H8_S) 613 call write_archive(nid,ntime,'C4H2_up', 614 . 'C4H2 in upper atmosphere','kg/kg',4,C4H2_S) 615 call write_archive(nid,ntime,'C4H6_up', 616 . 'C4H6 in upper atmosphere','kg/kg',4,C4H6_S) 617 call write_archive(nid,ntime,'C4H10_up', 618 . 'C4H10 in upper atmosphere','kg/kg',4,C4H10_S) 619 call write_archive(nid,ntime,'AC6H6_up', 620 . 'AC6H6 in upper atmosphere','kg/kg',4,AC6H6_S) 621 call write_archive(nid,ntime,'C3H2_up', 622 . 'C3H2 in upper atmosphere','kg/kg',4,C3H2_S) 623 call write_archive(nid,ntime,'C4H5_up', 624 . 'C4H5 in upper atmosphere','kg/kg',4,C4H5_S) 625 call write_archive(nid,ntime,'AC6H5_up', 626 . 'AC6H5 in upper atmosphere','kg/kg',4,AC6H5_S) 627 call write_archive(nid,ntime,'N2_up', 628 . 'N2 in upper atmosphere','kg/kg',4,N2_S) 629 call write_archive(nid,ntime,'N4S_up', 630 . 'N4S in upper atmosphere','kg/kg',4,N4S_S) 631 call write_archive(nid,ntime,'CN_up', 632 . 'CN in upper atmosphere','kg/kg',4,CN_S) 633 call write_archive(nid,ntime,'HCN_up', 634 . 'HCN in upper atmosphere','kg/kg',4,HCN_S) 635 call write_archive(nid,ntime,'H2CN_up', 636 . 'H2CN in upper atmosphere','kg/kg',4,H2CN_S) 637 call write_archive(nid,ntime,'CHCN_up', 638 . 'CHCN in upper atmosphere','kg/kg',4,CHCN_S) 639 call write_archive(nid,ntime,'CH2CN_up', 640 . 'CH2CN in upper atmosphere','kg/kg',4,CH2CN_S) 641 call write_archive(nid,ntime,'CH3CN_up', 642 . 'CH3CN in upper atmosphere','kg/kg',4,CH3CN_S) 643 call write_archive(nid,ntime,'C3N_up', 644 . 'C3N in upper atmosphere','kg/kg',4,C3N_S) 645 call write_archive(nid,ntime,'HC3N_up', 646 . 'HC3N in upper atmosphere','kg/kg',4,HC3N_S) 647 call write_archive(nid,ntime,'NCCN_up', 648 . 'NCCN in upper atmosphere','kg/kg',4,NCCN_S) 649 call write_archive(nid,ntime,'C4N2_up', 650 . 'C4N2 in upper atmosphere','kg/kg',4,C4N2_S) 651 ENDIF 652 473 653 c Fin 474 654 c----------------------------------------------------------------------- -
trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/write_archive.F
r1647 r1871 33 33 34 34 use comsoil_h, only: nsoilmx 35 use comchem_h, only: nlaykim_up 35 36 36 37 implicit none … … 160 161 #endif 161 162 162 ! For a 3D ocean temperature Variable 163 !------------------------------- 164 165 else if (dim.eq.-2) then 163 164 ! For a 3D upper chemistry Variable 165 !---------------------------------- 166 167 else if (dim.eq.4) then 166 168 ! get variables' ID, if it exists 167 169 ierr=NF_INQ_VARID(nid,nom,varid) … … 171 173 ierr=NF_INQ_DIMID(nid,"longitude",id(1)) 172 174 ierr=NF_INQ_DIMID(nid,"latitude",id(2)) 173 ierr=NF_INQ_DIMID(nid," ocean_layers",id(3))175 ierr=NF_INQ_DIMID(nid,"upper_chemistry_layers",id(3)) 174 176 if (ierr.ne.NF_NOERR) then 175 write(*,*)"write_archive: dimension <ocean_layers>",176 & "is missing !!!"177 write(*,*)"write_archive: dimension 178 & <upper_chemistry_layers> is missing !!!" 177 179 call abort 178 180 endif … … 194 196 edges(1)=iip1 195 197 edges(2)=jjp1 196 edges(3)= 1 ! JVO2017 : was noceanmx before -> set to 1198 edges(3)=nlaykim_up 197 199 edges(4)=1 198 200 #ifdef NC_DOUBLE … … 201 203 ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px) 202 204 #endif 203 204 205 205 206 -
trunk/LMDZ.TITAN/libf/phytitan/iostart.F90
r1815 r1871 15 15 INTEGER,SAVE :: idim6 ! "nlayer" dimension 16 16 INTEGER,SAVE :: idim7 ! "Time" dimension 17 INTEGER,SAVE :: idim8 ! "upper_chemistry_layers" dimension 17 18 INTEGER,SAVE :: timeindex ! current time index (for time-dependent fields) 18 !$OMP THREADPRIVATE(idim1,idim2,idim3,idim4,idim5,idim6,idim7, timeindex)19 !$OMP THREADPRIVATE(idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8,idim9,timeindex) 19 20 INTEGER,PARAMETER :: length=100 ! size of tab_cntrl array 20 21 … … 468 469 USE tracer_h, only: nqtot_p 469 470 USE comsoil_h, only: nsoilmx 471 USE comchem_h, only: nlaykim_up 470 472 471 473 IMPLICIT NONE … … 556 558 ENDIF 557 559 560 ierr=NF90_DEF_DIM(nid_restart,"upper_chemistry_layers",nlaykim_up,idim8) 561 IF (ierr/=NF90_NOERR) THEN 562 write(*,*)'open_restartphy: problem defining upper_chemistry_layers dimension ' 563 write(*,*)trim(nf90_strerror(ierr)) 564 CALL ABORT 565 ENDIF 566 558 567 ierr=NF90_ENDDEF(nid_restart) 559 568 IF (ierr/=NF90_NOERR) THEN … … 634 643 USE dimphy 635 644 USE comsoil_h, only: nsoilmx 645 USE comchem_h, only: nlaykim_up 636 646 USE mod_grid_phy_lmdz 637 647 USE mod_phys_lmdz_para … … 807 817 ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,& 808 818 (/idim2,idim3,idim7/),nvarid) 819 #endif 820 if (ierr.ne.NF90_NOERR) then 821 write(*,*)"put_field_rgen error: failed to define "//trim(field_name) 822 write(*,*)trim(nf90_strerror(ierr)) 823 endif 824 IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title) 825 ierr=NF90_ENDDEF(nid_restart) 826 endif 827 ! Write the variable 828 ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,& 829 start=(/1,1,timeindex/)) 830 831 endif ! of if (.not.present(time)) 832 833 ELSE IF (field_size==nlaykim_up) THEN 834 ! input is a 2D "upper chemistry" array 835 if (.not.present(time)) then ! for a time-independent field 836 ierr = NF90_REDEF(nid_restart) 837 #ifdef NC_DOUBLE 838 ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,& 839 (/idim2,idim8/),nvarid) 840 #else 841 ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,& 842 (/idim2,idim8/),nvarid) 843 #endif 844 if (ierr.ne.NF90_NOERR) then 845 write(*,*)"put_field_rgen error: failed to define "//trim(field_name) 846 write(*,*)trim(nf90_strerror(ierr)) 847 endif 848 IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title) 849 ierr = NF90_ENDDEF(nid_restart) 850 ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo) 851 else 852 ! check if the variable has already been defined: 853 ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid) 854 if (ierr/=NF90_NOERR) then ! variable not found, define it 855 ierr=NF90_REDEF(nid_restart) 856 #ifdef NC_DOUBLE 857 ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,& 858 (/idim2,idim8,idim7/),nvarid) 859 #else 860 ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,& 861 (/idim2,idim8,idim7/),nvarid) 809 862 #endif 810 863 if (ierr.ne.NF90_NOERR) then -
trunk/LMDZ.TITAN/libf/phytitan/tabfi_mod.F90
r1670 r1871 55 55 emissiv 56 56 use comsoil_h, only: volcapa 57 use comchem_h, only: nlaykim_up 57 58 use iostart, only: get_var 58 59 use mod_phys_lmdz_para, only: is_parallel … … 149 150 dtemisice(:)=0 !time scale for snow metamorphism 150 151 volcapa=1000000 ! volumetric heat capacity of subsurface 151 152 ! chemistry 153 nlaykim_up=70 ! size of vertical grid for upper chemistry 154 152 155 ELSE 153 156 !----------------------------------------------------------------------- … … 204 207 ! soil properties 205 208 volcapa = tab_cntrl(tab0+35) ! volumetric heat capacity 209 ! chemistry 210 nlaykim_up = nint(tab_cntrl(tab0+40)) ! size of vertical grid for upper chemistry 206 211 !----------------------------------------------------------------------- 207 212 ! Save some constants for later use (as routine arguments) … … 256 261 257 262 write(*,5) '(35) volcapa',tab_cntrl(tab0+35),volcapa 263 264 write(*,5) '(40) nlaykim_up',tab_cntrl(tab0+40),float(nlaykim_up) 258 265 259 266 write(*,*) … … 564 571 565 572 write(*,5) '(35) volcapa',tab_cntrl(tab0+35),volcapa 573 574 write(*,5) '(40) nlaykim_up',tab_cntrl(tab0+40),float(nlaykim_up) 566 575 567 576 write(*,*)
Note: See TracChangeset
for help on using the changeset viewer.
