Changeset 164 for trunk/LMDZ.MARS/libf
- Timestamp:
- Jun 17, 2011, 10:49:17 AM (14 years ago)
- Location:
- trunk/LMDZ.MARS/libf
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/libf/aeronomars/inichim_newstart.F
r38 r164 120 120 write(*,*) 'initracer: error expected dustbin=2' 121 121 else 122 noms(1)='dust_mass' ! dust mass mixing ratio 123 noms(2)='dust_number' ! dust number mixing ratio 122 ! noms(1)='dust_mass' ! dust mass mixing ratio 123 ! noms(2)='dust_number' ! dust number mixing ratio 124 ! same as above, but avoid explict possible out-of-bounds on array 125 noms(1)='dust_mass' ! dust mass mixing ratio 126 do iq=2,2 127 noms(iq)='dust_number' ! dust number mixing ratio 128 enddo 124 129 endif 125 130 endif … … 129 134 noms(nqmx)='h2o_vap' 130 135 mmol(nqmx)=18. 131 noms(nqmx-1)='h2o_ice' 132 mmol(nqmx-1)=18. 136 ! noms(nqmx-1)='h2o_ice' 137 ! mmol(nqmx-1)=18. 138 !"loop" to avoid potential out-of-bounds in array 139 do iq=nqmx-1,nqmx-1 140 noms(iq)='h2o_ice' 141 mmol(iq)=18. 142 enddo 133 143 endif 134 144 ! 3. Chemistry … … 164 174 write(*,*)'inichim_newstart: moving surface water ice to index ' 165 175 & ,nqmx-1 166 qsurf(1:ngridmx,nqmx-1)=qsurf(1:ngridmx,nqmx) 176 ! "loop" to avoid potential out-of-bounds on arrays 177 do iq=nqmx-1,nqmx-1 178 qsurf(1:ngridmx,iq)=qsurf(1:ngridmx,iq+1) 179 enddo 167 180 qsurf(1:ngridmx,nqmx)=0 168 181 endif … … 395 408 ! as in the old days, water vapour is last and water ice, 396 409 ! if present, is just before water vapour 397 nqchem(1)=igcm_co2 398 nqchem(2)=igcm_co 399 nqchem(3)=igcm_o 400 nqchem(4)=igcm_o1d 401 nqchem(5)=igcm_o2 402 nqchem(6)=igcm_o3 403 nqchem(7)=igcm_h 404 nqchem(8)=igcm_h2 405 nqchem(9)=igcm_oh 406 nqchem(10)=igcm_ho2 407 nqchem(11)=igcm_h2o2 408 nqchem(12)=igcm_n2 409 nqchem(13)=igcm_ar 410 nqchem(14)=igcm_h2o_ice 411 nqchem(15)=igcm_h2o_vap 410 do iq=1,15 ! loop so as to avoid out-of-bounds on array 411 if (iq==1) nqchem(i)=igcm_co2 412 if (iq==2) nqchem(i)=igcm_co 413 if (iq==3) nqchem(i)=igcm_o 414 if (iq==4) nqchem(i)=igcm_o1d 415 if (iq==5) nqchem(i)=igcm_o2 416 if (iq==6) nqchem(i)=igcm_o3 417 if (iq==7) nqchem(i)=igcm_h 418 if (iq==8) nqchem(i)=igcm_h2 419 if (iq==9) nqchem(i)=igcm_oh 420 if (iq==10) nqchem(i)=igcm_ho2 421 if (iq==11) nqchem(i)=igcm_h2o2 422 if (iq==12) nqchem(i)=igcm_n2 423 if (iq==13) nqchem(i)=igcm_ar 424 if (iq==14) nqchem(i)=igcm_h2o_ice 425 if (iq==15) nqchem(i)=igcm_h2o_vap 426 enddo 412 427 413 428 ! Load in chemistry data for initialization: -
trunk/LMDZ.MARS/libf/dyn3d/lect_start_archive.F
r146 r164 1136 1136 allocate(oldval(nsoilold+1)) 1137 1137 allocate(newval(nsoilmx)) 1138 do i=1,i mold+11139 do j=1,j mold+11138 do i=1,iip1 1139 do j=1,jjp1 1140 1140 ! copy values 1141 1141 oldval(1)=tsurfold(i,j) … … 1168 1168 oldgrid(1)=0. ! ground 1169 1169 oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold) 1170 do i=1,i mold+11171 do j=1,j mold+11170 do i=1,iip1 1171 do j=1,jjp1 1172 1172 ! copy values 1173 1173 oldval(1)=tsurfold(i,j) -
trunk/LMDZ.MARS/libf/dyn3d/newstart.F
r38 r164 14 14 c 15 15 c======================================================================= 16 17 ! to use 'getin' 18 USE ioipsl_getincom 16 19 17 20 implicit none … … 40 43 #include"advtrac.h" 41 44 #include"tracer.h" 45 #include "datafile.h" 42 46 c======================================================================= 43 47 c Declarations … … 50 54 c et autres: 51 55 c---------- 52 INTEGER lnblnk53 EXTERNAL lnblnk54 56 55 57 c Variables pour les lectures NetCDF des fichiers "start_archive" … … 358 360 relief="mola" 359 361 c enddo 362 363 ! before using datareadnc, "datafile" must be set (normaly done in inifis) 364 datafile="/u/forget/WWW/datagcm/datafile" ! default value 365 call getin("datadir",datafile) ! in case user specified another path 360 366 361 367 CALL datareadnc(relief,phis,alb,surfith,zmeaS,zstdS,zsigS,zgamS, … … 499 505 500 506 write(*,*) 501 write(*,*) modif(1:lnblnk(modif)) , ' : '507 write(*,*) trim(modif) , ' : ' 502 508 503 509 c 'flat : no topography ("aquaplanet")' 504 510 c ------------------------------------- 505 if ( modif(1:lnblnk(modif)) .eq. 'flat') then511 if (trim(modif) .eq. 'flat') then 506 512 c set topo to zero 507 513 CALL initial0(ip1jmp1,z_reel) … … 537 543 c bilball : albedo, inertie thermique uniforme 538 544 c -------------------------------------------- 539 else if ( modif(1:lnblnk(modif)) .eq. 'bilball') then545 else if (trim(modif) .eq. 'bilball') then 540 546 write(*,*) 'constante albedo and iner.therm:' 541 547 write(*,*) 'New value for albedo (ex: 0.25) ?' … … 564 570 c coldspole : sous-sol de la calotte sud toujours froid 565 571 c ----------------------------------------------------- 566 else if ( modif(1:lnblnk(modif)) .eq. 'coldspole') then572 else if (trim(modif) .eq. 'coldspole') then 567 573 write(*,*)'new value for the subsurface temperature', 568 574 & ' beneath the permanent southern polar cap ? (eg: 141 K)' … … 615 621 c ptot : Modification of the total pressure: ice + current atmosphere 616 622 c ------------------------------------------------------------------- 617 else if ( modif(1:lnblnk(modif)) .eq. 'ptot') then623 else if (trim(modif) .eq. 'ptot') then 618 624 619 625 c calcul de la pression totale glace + atm actuelle … … 699 705 c q=0 : set tracers to zero 700 706 c ------------------------- 701 else if ( modif(1:lnblnk(modif)) .eq. 'q=0') then707 else if (trim(modif) .eq. 'q=0') then 702 708 c mise a 0 des q (traceurs) 703 709 write(*,*) 'Tracers set to 0 (1.E-30 in fact)' … … 721 727 c q=x : initialise tracer manually 722 728 c -------------------------------- 723 else if ( modif(1:lnblnk(modif)) .eq. 'q=x') then729 else if (trim(modif) .eq. 'q=x') then 724 730 write(*,*) 'Which tracer do you want to modify ?' 725 731 do iq=1,nqmx … … 747 753 c ini_q : Initialize tracers for chemistry 748 754 c ----------------------------------------------- 749 else if ( modif(1:lnblnk(modif)) .eq. 'ini_q') then755 else if (trim(modif) .eq. 'ini_q') then 750 756 c For more than 32 layers, possible to initiate thermosphere only 751 757 thermo=0 … … 779 785 c ini_q-H2O : as above exept for the water vapour tracer 780 786 c ------------------------------------------------------ 781 else if ( modif(1:lnblnk(modif)) .eq. 'ini_q-H2O') then787 else if (trim(modif) .eq. 'ini_q-H2O') then 782 788 ! for more than 32 layers, possible to initiate thermosphere only 783 789 thermo=0 … … 812 818 c ini_q-iceH2O : as above exept for ice et H2O 813 819 c ----------------------------------------------- 814 else if ( modif(1:lnblnk(modif)) .eq. 'ini_q-iceH2O') then820 else if (trim(modif) .eq. 'ini_q-iceH2O') then 815 821 c For more than 32 layers, possible to initiate thermosphere only 816 822 thermo=0 … … 846 852 c wetstart : wet atmosphere with a north to south gradient 847 853 c -------------------------------------------------------- 848 else if ( modif(1:lnblnk(modif)) .eq. 'wetstart') then854 else if (trim(modif) .eq. 'wetstart') then 849 855 ! check that there is indeed a water vapor tracer 850 856 if (igcm_h2o_vap.eq.0) then … … 867 873 c noglacier : remove tropical water ice (to initialize high res sim) 868 874 c -------------------------------------------------- 869 else if ( modif(1:lnblnk(modif)) .eq. 'noglacier') then875 else if (trim(modif) .eq. 'noglacier') then 870 876 do ig=1,ngridmx 871 877 j=(ig-2)/iim +2 … … 880 886 c watercapn : H20 ice on permanent northern cap 881 887 c -------------------------------------------------- 882 else if ( modif(1:lnblnk(modif)) .eq. 'watercapn') then888 else if (trim(modif) .eq. 'watercapn') then 883 889 do ig=1,ngridmx 884 890 j=(ig-2)/iim +2 … … 895 901 c watercaps : H20 ice on permanent southern cap 896 902 c ------------------------------------------------- 897 else if ( modif(1:lnblnk(modif)) .eq. 'watercaps') then903 else if (trim(modif) .eq. 'watercaps') then 898 904 do ig=1,ngridmx 899 905 j=(ig-2)/iim +2 … … 910 916 c isotherm : Isothermal temperatures and no winds 911 917 c ------------------------------------------------ 912 else if ( modif(1:lnblnk(modif)) .eq. 'isotherm') then918 else if (trim(modif) .eq. 'isotherm') then 913 919 914 920 write(*,*)'Isothermal temperature of the atmosphere, … … 933 939 c co2ice=0 : remove CO2 polar ice caps' 934 940 c ------------------------------------------------ 935 else if ( modif(1:lnblnk(modif)) .eq. 'co2ice=0') then941 else if (trim(modif) .eq. 'co2ice=0') then 936 942 do ig=1,ngridmx 937 943 co2ice(ig)=0 … … 942 948 ! ---------------------------------------------------------------------- 943 949 944 else if ( modif(1:lnblnk(modif)).eq.'therm_ini_s') then950 else if (trim(modif).eq.'therm_ini_s') then 945 951 ! write(*,*)"surfithfi(1):",surfithfi(1) 946 952 do isoil=1,nsoilmx … … 965 971 ! ------------------------------------------------------------ 966 972 967 else if ( modif(1:lnblnk(modif)).eq.'subsoilice_n') then973 else if (trim(modif).eq.'subsoilice_n') then 968 974 969 975 write(*,*)'From which latitude (in deg.), up to the north pole, … … 1078 1084 ! ------------------------------------------------------------ 1079 1085 1080 else if ( modif(1:lnblnk(modif)).eq.'subsoilice_s') then1086 else if (trim(modif).eq.'subsoilice_s') then 1081 1087 1082 1088 write(*,*)'From which latitude (in deg.), down to the south pol … … 1179 1185 c 'mons_ice' : use MONS data to build subsurface ice table 1180 1186 c -------------------------------------------------------- 1181 else if ( modif(1:lnblnk(modif)).eq.'mons_ice') then1187 else if (trim(modif).eq.'mons_ice') then 1182 1188 1183 1189 ! 1. Load MONS data … … 1285 1291 else 1286 1292 write(*,*) ' Unknown (misspelled?) option!!!' 1287 end if ! of if ( modif(1:lnblnk(modif)) .eq. '...') elseif ...1293 end if ! of if (trim(modif) .eq. '...') elseif ... 1288 1294 1289 1295 enddo ! of do ! infinite loop on liste of changes -
trunk/LMDZ.MARS/libf/phymars/datareadnc.F
r146 r164 123 123 write(*,*)'1) You can set this path in the callphys.def file:' 124 124 write(*,*)' datadir=/path/to/the/datafiles' 125 write(*,*)'2) If necessary surface.nc (and other datafiles)' 125 write(*,*)' OR specify the path to use in callphys.def, as:' 126 write(*,*)' datadir=/path/to/the/directory' 127 write(*,*)'2) If necessary, surface.nc (and other datafiles)' 126 128 write(*,*)' can be obtained online on:' 127 129 write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile' -
trunk/LMDZ.MARS/libf/phymars/initracer.F
r91 r164 111 111 write(*,*) 'initracer: error expected dustbin=2' 112 112 else 113 noms(1)='dust_mass' ! dust mass mixing ratio 114 noms(2)='dust_number' ! dust number mixing ratio 113 ! noms(1)='dust_mass' ! dust mass mixing ratio 114 ! noms(2)='dust_number' ! dust number mixing ratio 115 ! same as above, but avoid explict possible out-of-bounds on array 116 noms(1)='dust_mass' ! dust mass mixing ratio 117 do iq=2,2 118 noms(iq)='dust_number' ! dust number mixing ratio 119 enddo 115 120 endif 116 121 endif … … 120 125 noms(nqmx)='h2o_vap' 121 126 mmol(nqmx)=18. 122 noms(nqmx-1)='h2o_ice' 123 mmol(nqmx-1)=18. 127 ! noms(nqmx-1)='h2o_ice' 128 ! mmol(nqmx-1)=18. 129 !"loop" to avoid potential out-of-bounds in array 130 do iq=nqmx-1,nqmx-1 131 noms(iq)='h2o_ice' 132 mmol(iq)=18. 133 enddo 124 134 endif 125 135 ! 3. Chemistry … … 157 167 if (oldnames.and.water) then 158 168 write(*,*)'initracer: moving surface water ice to index ',nqmx-1 159 qsurf(1:ngridmx,nqmx-1)=qsurf(1:ngridmx,nqmx) 169 ! "loop" to avoid potential out-of-bounds on arrays 170 do iq=nqmx-1,nqmx-1 171 qsurf(1:ngridmx,iq)=qsurf(1:ngridmx,iq+1) 172 enddo 160 173 qsurf(1:ngridmx,nqmx)=0 161 174 endif -
trunk/LMDZ.MARS/libf/phymars/iniwrite.F
r38 r164 36 36 c ---------- 37 37 38 integer nid ! NetCDF file ID39 INTEGER*4 idayref ! date (initial date for this run)40 REALphis(ip1jmp1) ! surface geopotential38 integer,intent(in) :: nid ! NetCDF file ID 39 INTEGER*4,intent(in) :: idayref ! date (initial date for this run) 40 real,intent(in) :: phis(ip1jmp1) ! surface geopotential 41 41 42 42 c Local: -
trunk/LMDZ.MARS/libf/phymars/physdem1.F
r38 r164 565 565 ! back to qsurf(nqmx) 566 566 IF (water) THEN 567 !"loop" to avoid potential out-of-bounds on arrays 567 568 write(*,*)'physdem1: moving surface water ice to index ',nqmx 568 qsurf(1:ngridmx,nqmx)=qsurf(1:ngridmx,nqmx-1) 569 qsurf(1:ngridmx,nqmx-1)=0 569 do iq=nqmx,nqmx 570 qsurf(1:ngridmx,iq)=qsurf(1:ngridmx,iq-1) 571 qsurf(1:ngridmx,iq-1)=0 572 enddo 570 573 ENDIF 571 574 endif ! of if (count.eq.nqmx) -
trunk/LMDZ.MARS/libf/phymars/physiq.F
r161 r164 1308 1308 c call WRITEDIAGFI(ngrid,"emis","Surface emissivity","w.m-1",2, 1309 1309 c & emis) 1310 call WRITEDIAGFI(ngrid,"pplay","Pressure","Pa",3,zplay)1311 call WRITEDIAGFI(ngrid,"pplev","Pressure","Pa",3,zplev)1310 ! call WRITEDIAGFI(ngrid,"pplay","Pressure","Pa",3,zplay) 1311 ! call WRITEDIAGFI(ngrid,"pplev","Pressure","Pa",3,zplev) 1312 1312 call WRITEDIAGFI(ngrid,"tsurf","Surface temperature","K",2, 1313 1313 & tsurf) 1314 1314 call WRITEDIAGFI(ngrid,"ps","surface pressure","Pa",2,ps) 1315 ccall WRITEDIAGFI(ngrid,"co2ice","co2 ice thickness","kg.m-2",2,1316 c& co2ice)1315 call WRITEDIAGFI(ngrid,"co2ice","co2 ice thickness","kg.m-2",2, 1316 & co2ice) 1317 1317 c call WRITEDIAGFI(ngrid,"temp7","temperature in layer 7", 1318 1318 c & "K",2,zt(1,7)) … … 1331 1331 call WRITEDIAGFI(ngrid,"rho","density","none",3,rho) 1332 1332 c call WRITEDIAGFI(ngrid,"q2","q2","kg.m-3",3,q2) 1333 call WRITEDIAGFI(ngrid,'Teta','T potentielle','K',3,zh)1333 ! call WRITEDIAGFI(ngrid,'Teta','T potentielle','K',3,zh) 1334 1334 c call WRITEDIAGFI(ngrid,"pressure","Pressure","Pa",3,pplay) 1335 1335 c call WRITEDIAGFI(ngrid,"ssurf","Surface stress","N.m-2",2, … … 1536 1536 & zq(ig,l,1)*(pplev(ig,l)-pplev(ig,l+1))/g 1537 1537 if (nqmx .gt. 1) then 1538 iq=2 ! to avoid out-of-bounds spotting by picky compilers 1539 ! when gcm is compiled with only one tracer 1538 1540 dummycol(ig)=dummycol(ig)+ 1539 & zq(ig,l, 2)*(pplev(ig,l)-pplev(ig,l+1))/g1541 & zq(ig,l,iq)*(pplev(ig,l)-pplev(ig,l+1))/g 1540 1542 endif 1541 1543 enddo
Note: See TracChangeset
for help on using the changeset viewer.