Changeset 808
- Timestamp:
- Oct 16, 2012, 12:57:35 PM (12 years ago)
- Location:
- trunk
- Files:
-
- 10 added
- 2 deleted
- 35 edited
- 2 moved
-
DOC/chantiers/commit_importants.log (modified) (1 diff)
-
LMDZ.COMMON/libf/dyn3dpar/grid_noro.F (deleted)
-
LMDZ.COMMON/libf/dyn3dpar/startvar.F90 (deleted)
-
LMDZ.TITAN/deftank/physiq.def (modified) (1 diff)
-
LMDZ.TITAN/libf/phytitan/cnuages3D.F (modified) (8 diffs)
-
LMDZ.TITAN/libf/phytitan/cooling.F (modified) (1 diff)
-
LMDZ.TITAN/libf/phytitan/effg.F (modified) (1 diff)
-
LMDZ.TITAN/libf/phytitan/gasses.F (modified) (1 diff)
-
LMDZ.TITAN/libf/phytitan/optci.F (modified) (1 diff)
-
LMDZ.TITAN/libf/phytitan/optci_1pt.F (modified) (1 diff)
-
LMDZ.TITAN/libf/phytitan/optci_1pt_2.F (modified) (1 diff)
-
LMDZ.TITAN/libf/phytitan/optci_1pt_3.F (added)
-
LMDZ.TITAN/libf/phytitan/optcld.F90 (added)
-
LMDZ.TITAN/libf/phytitan/optcv.F (modified) (1 diff)
-
LMDZ.TITAN/libf/phytitan/optcv_1pt_3.F (added)
-
LMDZ.TITAN/libf/phytitan/phyetat0.F (modified) (1 diff)
-
LMDZ.TITAN/libf/phytitan/physiq.F (modified) (3 diffs)
-
LMDZ.TITAN/libf/phytitan/phytrac.F (modified) (3 diffs)
-
LMDZ.TITAN/libf/phytitan/radtitan.F (modified) (3 diffs)
-
LMDZ.TITAN/libf/phytitan/sources.F (modified) (7 diffs)
-
LMDZ.TITAN/libf/phytitan/write_histday.h (modified) (2 diffs)
-
LMDZ.TITAN/libf/phytitan/write_histins.h (modified) (1 diff)
-
LMDZ.TITAN/libf/phytitan/write_histmth.h (modified) (2 diffs)
-
LMDZ.TITAN/libf/phytitan/yamada4.F (modified) (1 diff)
-
LMDZ.VENUS/libf/phyvenus/clcdrag.F90 (modified) (2 diffs)
-
LMDZ.VENUS/libf/phyvenus/clmain.F (modified) (1 diff)
-
LMDZ.VENUS/libf/phyvenus/flott_gwd_ran.F90 (modified) (14 diffs)
-
LMDZ.VENUS/libf/phyvenus/grid_noro.F (moved) (moved from trunk/LMDZ.COMMON/libf/dyn3d/grid_noro.F) (17 diffs)
-
LMDZ.VENUS/libf/phyvenus/gwprofil.F (modified) (1 diff)
-
LMDZ.VENUS/libf/phyvenus/ini_archive.F (added)
-
LMDZ.VENUS/libf/phyvenus/ini_histday.h (modified) (1 diff)
-
LMDZ.VENUS/libf/phyvenus/ini_histrac.h (modified) (1 diff)
-
LMDZ.VENUS/libf/phyvenus/interp_vert.F (added)
-
LMDZ.VENUS/libf/phyvenus/lw_venus_ve.F (modified) (1 diff)
-
LMDZ.VENUS/libf/phyvenus/physiq.F (modified) (10 diffs)
-
LMDZ.VENUS/libf/phyvenus/readstart.F (added)
-
LMDZ.VENUS/libf/phyvenus/readstartphy.F (modified) (4 diffs)
-
LMDZ.VENUS/libf/phyvenus/scal_wind.F (added)
-
LMDZ.VENUS/libf/phyvenus/startvar.F90 (moved) (moved from trunk/LMDZ.COMMON/libf/dyn3d/startvar.F90) (10 diffs)
-
LMDZ.VENUS/libf/phyvenus/wind_scal.F (added)
-
LMDZ.VENUS/libf/phyvenus/write_archive.F (added)
-
LMDZ.VENUS/libf/phyvenus/write_histday.h (modified) (1 diff)
-
LMDZ.VENUS/libf/phyvenus/write_histrac.h (modified) (1 diff)
-
LMDZ.VENUS/libf/phyvenus/writerestart.F (added)
-
LMDZ.VENUS/libf/phyvenus/writerestartphy.F (modified) (3 diffs)
-
UTIL/NCL/help.txt (modified) (1 diff)
-
UTIL/NCL/planeto.ncl (modified) (2 diffs)
-
UTIL/NCL/visu-ncl (modified) (5 diffs)
-
UTIL/NCL/visu-utils.ncl (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/DOC/chantiers/commit_importants.log
r776 r808 1099 1099 that kills 1+1=2 in dynamics) 1100 1100 1101 ********************* 1102 **** commit_v808 **** 1103 ********************* 1104 1105 For Venus (but should be done for Titan also, soon): 1106 1107 To be able to use start2archive.F and newstart-VT.F, the following routines are added in the phy* directory: 1108 ini_archive.F 1109 interp_vert.F 1110 readstart.F 1111 scal_wind.F 1112 wind_scal.F 1113 write_archive.F 1114 writerestart.F 1115 1116 Also, dyn3d/startvar.F90 and dyn3d/grid_noro have been transfered to the 1117 phyvenus directory and adapted (mostly to remove the mask). They have also been removed from dyn3dpar. 1118 1119 start2archive.F and newstart-VT.F should be in dyn3d. However, they depend on the planet. For the moment, not put in the SVN depository... 1120 1121 For Titan: 1122 1123 Update to be able to run clouds in the GCM. TO BE CHECKED ! 1124 - optc*_1pt3 replace optc*_1pt2 (called in optc*.F) 1125 - use of effg (though effg=RG for the moment) everywhere it was already implemented. Beware that there are still lots of places where RG is used directly. Many modifications still to be done for variable g. 1126 - added optcld.F90 1127 - physiq.F, write_hist[day/mth].h : use of zlsm1 to get a correct average of Ls in the outputs when crossing the 360->0 transition. 1128 1129 + some changes in NCL scripts... 1130 -
trunk/LMDZ.TITAN/deftank/physiq.def
r495 r808 53 53 # TITAN ## 54 54 year_day = 673. 55 peri_day = 53 3.55 peri_day = 536. 56 56 periheli = 1354.5 57 57 aphelie = 1506.0 -
trunk/LMDZ.TITAN/libf/phytitan/cnuages3D.F
r175 r808 131 131 real especes(NG,NL,3*nrad+1) 132 132 real condens(NG,NL,nrad) 133 real gg,xmair 133 real gg(NL),xmair 134 real effg ! effg est une fonction(z), z en m. 134 135 135 136 integer jsup,jinf,h,i,j,k,ndim … … 143 144 ndim=3*nrad+1 144 145 145 gg=g0 146 do j=1,NL 147 gg(j)=effg(z(j)) 148 enddo 146 149 147 150 ********************************************* … … 167 170 enddo 168 171 169 gg=g0*rtit**2/(rtit+z(j))**2. 170 xmair=(pb(j+1)-pb(j))/gg/dzb(j) 172 xmair=(pb(j+1)-pb(j))/gg(j)/dzb(j) 171 173 172 174 do k=1,nrad … … 196 198 do j=1,NL 197 199 198 gg=g0*rtit**2/(rtit+z(j))**2. 199 xmair=(pb(j+1)-pb(j))/gg/dzb(j) 200 xmair=(pb(j+1)-pb(j))/gg(j)/dzb(j) 200 201 201 202 * ici ce sont les tendances a sortir de nuages.F pour le methane.... … … 245 246 enddo 246 247 247 gg=g0*rtit**2/(rtit+z(j))**2. 248 xmair=(pb(j+1)-pb(j))/gg/dzb(j) 248 xmair=(pb(j+1)-pb(j))/gg(j)/dzb(j) 249 249 250 250 do k=1,nrad … … 267 267 do i=1,ng1 268 268 do j=1,NL 269 gg=g0*rtit**2/(rtit+z(j))**2. 270 xmair=(pb(j+1)-pb(j))/gg/dzb(j) 269 xmair=(pb(j+1)-pb(j))/gg(j)/dzb(j) 271 270 272 271 * ici ce sont les tendances a sortir de nuages.F pour l'ethane.... … … 311 310 tdq( i,j,k,3) = 0. 312 311 enddo 313 gg=g0*rtit**2/(rtit+z(j))**2. 314 xmair=(pb(j+1)-pb(j))/gg/dzb(j) 312 xmair=(pb(j+1)-pb(j))/gg(j)/dzb(j) 315 313 316 314 do k=1,nrad … … 333 331 do j=1,NL 334 332 335 gg=g0*rtit**2/(rtit+z(j))**2. 336 xmair=(pb(j+1)-pb(j))/gg/dzb(j) 333 xmair=(pb(j+1)-pb(j))/gg(j)/dzb(j) 337 334 338 335 * ici ce sont les tendances a sortir de nuages.F pour l'ethane.... -
trunk/LMDZ.TITAN/libf/phytitan/cooling.F
r495 r808 58 58 #include "dimensions.h" 59 59 #include "YOMCST.h" 60 #include "clesphys.h" 60 61 INTEGER NLAYER,NSPECI,NSPC1I 61 62 PARAMETER(NLAYER=llm) -
trunk/LMDZ.TITAN/libf/phytitan/effg.F
r306 r808 1 1 FUNCTION EFFG(Z) 2 2 #include "YOMCST.h" 3 ! RA en m, Z en km... 4 EFFG = RG * (RA/(RA + Z*1000. ) )**2 3 ! RA en m, Z en m... 4 5 ! Quand on prendra atmosphere epaisse dans dynamique 6 ! (et dans physique, attention a clmain et autres...) 7 8 ! EFFG = RG * (RA/(RA + Z ) )**2 9 10 ! Pour l'instant: 11 EFFG = RG 5 12 RETURN 6 13 END -
trunk/LMDZ.TITAN/libf/phytitan/gasses.F
r3 r808 16 16 DO 159 J=1,NLAYER 17 17 EMU=(XMU(J+1)+XMU(J))*0.5 18 COLDEN(J)=RHOP*(PRESS(J+1)-PRESS(J))/EFFG(Z(J)) 18 c attention ici, Z en km doit etre passe en m 19 COLDEN(J)=RHOP*(PRESS(J+1)-PRESS(J))/EFFG(Z(J)*1000.) 19 20 GAS1(J)=(16./EMU)*AVERGE(CH4(J+1),CH4(J)) 20 21 159 CONTINUE -
trunk/LMDZ.TITAN/libf/phytitan/optci.F
r495 r808 268 268 c if ((microfi.eq.0).or.(ig.eq.(klon/2+16))) iout=1 269 269 if (seulmtunpt.eq.0) then 270 call optci_1pt 2(zqaer_1pt,rmcbar(ig,:),xfbar(ig,:,:),270 call optci_1pt3(zqaer_1pt,rmcbar(ig,:),xfbar(ig,:,:), 271 271 & iopti,iout) 272 272 iopti = 1 -
trunk/LMDZ.TITAN/libf/phytitan/optci_1pt.F
r495 r808 90 90 PBAR=SQRT(PRESS(J)*PRESS(J+1)) 91 91 BMU=0.5*(XMU(J+1)+XMU(J)) 92 c attention ici, Z en km doit etre passe en m 92 93 COEF1=RGAS*273.15**2*.5E5* (PRESS(J+1)**2 - PRESS(J)**2) 93 & /(1.01325**2 *EFFG(Z(J) )*TBAR*BMU)94 95 IF (IPRINT .GT. 9) WRITE(6,21) J,EFFG(Z(J) ),TBAR,BMU,COEF194 & /(1.01325**2 *EFFG(Z(J)*1000.)*TBAR*BMU) 95 96 IF (IPRINT .GT. 9) WRITE(6,21) J,EFFG(Z(J)*1000.),TBAR,BMU,COEF1 96 97 21 FORMAT(' J, EFFG, TBAR, BMU, COEF1,: ',I3,1P6E10.3) 97 98 -
trunk/LMDZ.TITAN/libf/phytitan/optci_1pt_2.F
r495 r808 90 90 PBAR=SQRT(PRESS(J)*PRESS(J+1)) 91 91 BMU=0.5*(XMU(J+1)+XMU(J)) 92 c attention ici, Z en km doit etre passe en m 92 93 COEF1=RGAS*273.15**2*.5E5* (PRESS(J+1)**2 - PRESS(J)**2) 93 & /(1.01325**2 *EFFG(Z(J) )*TBAR*BMU)94 95 IF (IPRINT .GT. 9) WRITE(6,21) J,EFFG(Z(J) ),TBAR,BMU,COEF194 & /(1.01325**2 *EFFG(Z(J)*1000.)*TBAR*BMU) 95 96 IF (IPRINT .GT. 9) WRITE(6,21) J,EFFG(Z(J)*1000.),TBAR,BMU,COEF1 96 97 21 FORMAT(' J, EFFG, TBAR, BMU, COEF1,: ',I3,1P6E10.3) 97 98 -
trunk/LMDZ.TITAN/libf/phytitan/optcv.F
r495 r808 202 202 c if ((microfi.eq.0).or.(ig.eq.klon/2)) iout=1 203 203 if (seulmtunpt.eq.0) then 204 call optcv_1pt 2(zqaer_1pt,rmcbar(ig,:),xfbar(ig,:,:),204 call optcv_1pt3(zqaer_1pt,rmcbar(ig,:),xfbar(ig,:,:), 205 205 & ioptv,IPRINT) 206 206 ioptv = 1 -
trunk/LMDZ.TITAN/libf/phytitan/phyetat0.F
r175 r808 92 92 itau_phy = tab_cntrl(15) 93 93 94 c Attention si raz_date est active : 95 c il faut remettre a zero itau_phy apres phyetat0 ! 96 IF (raz_date.eq.1) THEN 97 itau_phy=0 98 ENDIF 99 94 100 c 95 101 c Lecture des latitudes (coordonnees): -
trunk/LMDZ.TITAN/libf/phytitan/physiq.F
r495 r808 286 286 REAL dist, rmu0(klon), fract(klon), pdecli 287 287 REAL zday 288 REAL zls 288 REAL zls,zlsm1 289 289 c 290 290 INTEGER i, k, iq, ig, j, ll, l … … 794 794 DO l=1,klev 795 795 DO i=1,klon 796 czzlay(i,l)=zphi(i,l)/RG796 zzlay(i,l)=zphi(i,l)/RG 797 797 c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE: 798 798 c zzlay(i,l)=RG*RA*RA/(RG*RA-zphi(i,l))-RA 799 799 ENDDO 800 800 ENDDO … … 863 863 print*,'Ls',zls*180./RPI ! zls est en radians !! 864 864 CALL orbite(zls,dist,pdecli) 865 IF (debut) zlsm1=zls 865 866 866 867 c dans zenang, Ls en degres ; dans mucorr, Ls en radians -
trunk/LMDZ.TITAN/libf/phytitan/phytrac.F
r474 r808 732 732 d_tr_mph(i,l,iq) = (qaer(i,l,iq)-qaer0(i,l,iq))/ 733 733 & ptimestep 734 c Traceurs microphysiques: passage en intensif: n/m^2 --> n/kg735 d_tr_mph(i,l,iq) = d_tr_mph(i,l,iq)*RG/delp(i,l)736 734 ENDDO 737 735 ENDDO … … 743 741 DO i = 1, klon 744 742 d_tr_mph(i,l,iq)=(qaer(i,l,iq)-qaer0(i,l,iq))/ptimestep 743 ENDDO 744 ENDDO 745 ENDDO 746 747 ENDIF ! microfi 748 749 DO iq=1,nmicro 750 DO l=1,llm 751 DO i = 1, klon 745 752 c Traceurs microphysiques: passage en intensif: n/m^2 --> n/kg 746 d_tr_mph(i,l,iq) = d_tr_mph(i,l,iq)*RG/delp(i,l) 747 ENDDO 748 ENDDO 749 ENDDO 750 751 ENDIF ! microfi 753 d_tr_mph(i,l,iq) = d_tr_mph(i,l,iq)*RG/delp(i,l) 754 ENDDO 755 ENDDO 756 ENDDO 752 757 753 758 c AUTRES TRACEURS … … 970 975 RETURN 971 976 END 977 -
trunk/LMDZ.TITAN/libf/phytitan/radtitan.F
r175 r808 34 34 use dimphy 35 35 USE comgeomphy 36 USE optcld, only : iniqcld 36 37 IMPLICIT NONE 37 38 #include "dimensions.h" … … 136 137 print*,'FHVIS = ',FHVIS 137 138 print*,'FHIR = ',FHIR 139 c on initialise le paquet optcld 140 call iniqcld() 138 141 iprem=1 139 142 endif … … 225 228 enddo 226 229 do i=1,nlayer 227 colden(i)=rhop*(press(i+1)-press(i))/effg(z(i)) 230 c attention ici, Z en km doit etre passe en m 231 colden(i)=rhop*(press(i+1)-press(i))/effg(z(i)*1000.) 228 232 gas1(i)=0. 229 233 emu=(xmu(i+1)+xmu(i))/2. -
trunk/LMDZ.TITAN/libf/phytitan/sources.F
r474 r808 47 47 REAL zcdv(klon),zu2,pz0 48 48 REAL xmair,gg,zrho,ws,ch,qch4,flux 49 REAL effg ! effg est une fonction(z), z en m. 49 50 REAL xmuair 50 51 REAL zmem,zmem2,zmem3 … … 92 93 DO ig=1,ngrid 93 94 zu2=pu(ig)*pu(ig)+pv(ig)*pv(ig)+umin 94 zcdv(ig)=pz0*( 1.+sqrt(zu2))95 zcdv(ig)=pz0*(sqrt(zu2)) 95 96 c write(99,'(I4,3(ES24.17,1X))') ig, 96 c & pz0,zu2,( 1.+sqrt(zu2))97 c & pz0,zu2,(sqrt(zu2)) 97 98 ENDDO 98 99 c write(99,*) "" … … 107 108 zevapch4=0. 108 109 restemp=0. 109 gg= RG*RA**2/(RA+pzlay(ig,1))**2.110 gg=effg(pzlay(ig,1)) 110 111 zrho=(pplev(ig,1)-pplev(ig,2))/gg 111 112 zrho=zrho/(pzlev(ig,2)-pzlev(ig,1)) … … 127 128 & /(1.+flux*ptimestep) 128 129 129 gg= RG!*RA**2/(RA+pzlay(ig,1))**2.130 gg=effg(pzlay(ig,1)) 130 131 xmair=(pplev(ig,1)-pplev(ig,1+1))/gg 131 132 xmair=xmair/(pzlev(ig,1+1)-pzlev(ig,1)) … … 156 157 ENDIF 157 158 c 158 evapch4(ig) =evapch4(ig)+zevapch4 ! evapch4 doit etre < 0159 evapch4(ig) = zevapch4 ! < 0 si volume évaporé (m3/m2) 159 160 160 161 ENDDO … … 168 169 DO ilev=nlay,nlay-4,-1 169 170 * calcule de zrho (kg/m3) pour la couche... 170 gg= RG*RA**2/(RA+pzlay(ig,ilev))**2.171 gg=effg(pzlay(ig,ilev)) 171 172 zrho=(pplev(ig,ilev)-pplev(ig,ilev+1))/gg 172 173 zrho=zrho/(pzlev(ig,ilev+1)-pzlev(ig,ilev)) … … 202 203 DO ilev=nlay,nlay-4,-1 203 204 * calcule de zrho (kg/m3) pour la couche... 204 gg= RG*RA**2/(RA+pzlay(ig,ilev))**2.205 gg=effg(pzlay(ig,ilev)) 205 206 zrho=(pplev(ig,ilev)-pplev(ig,ilev+1))/gg 206 207 zrho=zrho/(pzlev(ig,ilev+1)-pzlev(ig,ilev)) -
trunk/LMDZ.TITAN/libf/phytitan/write_histday.h
r474 r808 27 27 CALL histwrite(nid_day,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 28 28 c 29 ccccccc axe Ls 29 ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement... 30 30 do j=1,jjmp1 31 31 do i=1,iim … … 33 33 enddo 34 34 enddo 35 c Correction passage de 360 à 0... Sinon probleme avec moyenne 36 if (zls.lt.zlsm1) then 37 zx_tmp_2d = zx_tmp_2d+360. 38 zlsm1 = 2.*RPI 39 else 40 zlsm1 = zls 41 endif 35 42 CALL histwrite(nid_day,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 36 43 c -
trunk/LMDZ.TITAN/libf/phytitan/write_histins.h
r175 r808 27 27 CALL histwrite(nid_ins,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 28 28 c 29 ccccccc axe Ls 29 ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement... 30 30 do j=1,jjmp1 31 31 do i=1,iim -
trunk/LMDZ.TITAN/libf/phytitan/write_histmth.h
r474 r808 23 23 CALL histwrite(nid_mth,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 24 24 c 25 ccccccc axe Ls 25 ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement... 26 26 do j=1,jjmp1 27 27 do i=1,iim … … 29 29 enddo 30 30 enddo 31 c Correction passage de 360 à 0... Sinon probleme avec moyenne 32 if (zls.lt.zlsm1) then 33 zx_tmp_2d = zx_tmp_2d+360. 34 zlsm1 = 2.*RPI 35 else 36 zlsm1 = zls 37 endif 31 38 CALL histwrite(nid_mth,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 32 39 c -
trunk/LMDZ.TITAN/libf/phytitan/yamada4.F
r102 r808 434 434 435 435 do ig=1,ngrid 436 coriol(ig)=1.e-4 437 pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5 )438 enddo 439 440 441 436 coriol(ig)=1.e-4*86400/RDAY !! scaling... should be checked 437 pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5*86400/RDAY) 438 enddo 439 c if (first) then 440 c print*,'A REVOIR!! coriol ?? pblhmin ',pblhmin 441 c endif 442 442 CTest a remettre 21 11 02 443 443 c test abd 13 05 02 if(0.eq.1) then -
trunk/LMDZ.VENUS/libf/phyvenus/clcdrag.F90
r97 r808 40 40 INTEGER :: i 41 41 REAL :: zdu2, ztsolv, ztvd, zscf 42 REAL :: zucf , zcr42 REAL :: zucf 43 43 REAL :: friv, frih 44 44 REAL, dimension(klon) :: zcfm1, zcfm2 … … 93 93 pcfh(i) = zcdn(i)* fins(zri(i)) 94 94 ENDIF 95 zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)96 95 ENDIF 97 96 END DO -
trunk/LMDZ.VENUS/libf/phyvenus/clmain.F
r101 r808 342 342 y_cd_m(1:knon) = ycoefh(1:knon,1) 343 343 endif 344 344 345 call ustarhb(knon,yu,yv,y_cd_m, yustar) 345 346 -
trunk/LMDZ.VENUS/libf/phyvenus/flott_gwd_ran.F90
r778 r808 50 50 ! 0.3.1 GRAVITY-WAVES SPECIFICATIONS 51 51 52 !VENUS INTEGER, PARAMETER:: NK = 4, NP = 4, NO = 4, NW = NK * NP * NO 52 !VENUS 53 INTEGER, PARAMETER:: NK = 2, NP = 2, NO = 2, NW = NK * NP * NO 53 54 !Online output: change NO 54 INTEGER, PARAMETER:: NK = 1, NP = 2, NO = 10, NW = NK * NP * NO55 ! INTEGER, PARAMETER:: NK = 1, NP = 2, NO = 11, NW = NK * NP * NO 55 56 INTEGER JK, JP, JO, JW 56 57 REAL KMIN, KMAX ! Min and Max horizontal wavenumbers … … 85 86 ! 0.3.3 BACKGROUND FLOW AT 1/2 LEVELS AND VERTICAL COORDINATE 86 87 87 REAL H0(KLON, KLEV) ! Characteristic Height of the atmosphere 88 REAL PR ! Reference Pressure 89 90 REAL ZH(KLON, KLEV + 1) ! Log-pressure altitude 88 REAL H0bis(KLON, KLEV) ! Characteristic Height of the atmosphere 89 REAL H0 ! Characteristic Height of the atmosphere 90 REAL PR, TR ! Reference Pressure and Temperature 91 92 REAL ZH(KLON, KLEV + 1) ! Log-pressure altitude (constant H0) 93 REAL ZHbis(KLON, KLEV + 1) ! Log-pressure altitude (varying H) 91 94 92 95 REAL UH(KLON, KLEV + 1), VH(KLON, KLEV + 1) ! Winds at 1/2 levels … … 109 112 DATA firstcall/.true./ 110 113 114 REAL ALEAS 115 EXTERNAL ALEAS 116 111 117 !----------------------------------------------------------------- 112 118 ! 1. INITIALISATIONS … … 130 136 !Online output: one value only 131 137 if (output) then 132 KMIN = 1.3E-5133 KMAX = 1.3E-5138 KMIN = 6.3E-6 139 KMAX = 6.3E-6 134 140 endif 135 141 CMIN = 1. ! Min phase velocity 136 CMAX = 6 0. ! Max phase speed velocity142 CMAX = 61. ! Max phase speed velocity 137 143 XLAUNCH=0.6 ! Parameter that control launching altitude 138 144 139 145 PR = 9.2e6 ! Reference pressure ! VENUS!! 146 TR = 240. ! Reference Temperature ! VENUS: cloud layer 147 H0 = RD * TR / RG ! Characteristic vertical scale height 140 148 141 149 BVSEC = 1.E-5 ! Security to avoid negative BVF 142 PSEC = 1.E- 6! Security to avoid division by 0 pressure143 ZOISEC = 1.E- 6! Security FOR 0 INTRINSIC FREQ150 PSEC = 1.E-8 ! Security to avoid division by 0 pressure 151 ZOISEC = 1.E-8 ! Security FOR 0 INTRINSIC FREQ 144 152 145 153 IF(DELTAT.LT.DTIME)THEN … … 171 179 DO II = 1, KLON 172 180 ! Horizontal wavenumber amplitude 173 ZK(JW, II) = KMIN + (KMAX - KMIN) * MOD(TT(II, JW) * 100., 1.) 181 ! ZK(JW, II) = KMIN + (KMAX - KMIN) * MOD(TT(II, JW) * 100., 1.) 182 ZK(JW, II) = KMIN + (KMAX - KMIN) * ALEAS(0.) 174 183 ! Horizontal phase speed 175 CPHA = CMIN + (CMAX - CMIN) * MOD(TT(II, JW)**2, 1.) 184 ! CPHA = CMIN + (CMAX - CMIN) * MOD(TT(II, JW)**2, 1.) 185 CPHA = CMIN + (CMAX - CMIN) * ALEAS(0.) 176 186 !Online output: linear 177 if (output) CPHA = CMIN + (CMAX - CMIN) * JO/NO187 if (output) CPHA = CMIN + (CMAX - CMIN) * (JO-1)/(NO-1) 178 188 ! Intrinsic frequency 179 189 ZO(JW, II) = CPHA * ZK(JW, II) … … 181 191 ! RUW0(JW, II) = RUWMAX / REAL(NW) & 182 192 RUW0(JW, II) = RUWMAX & 183 * MOD(100. * (UU(II, JW)**2 + VV(II, JW)**2), 1.) 193 ! * MOD(100. * (UU(II, JW)**2 + VV(II, JW)**2), 1.) 194 * ALEAS(0.) 195 !Online output: fixed to max 196 if (output) RUW0(JW, II) = RUWMAX 184 197 ENDDO 185 198 end DO … … 209 222 210 223 ! Log pressure vert. coordinate (altitude above surface) 211 ZH (:,1) = 0.224 ZHbis(:,1) = 0. 212 225 DO LL = 2, KLEV + 1 213 H0(:, LL-1) = RD * TT(:, LL-1) / RG 214 ZH(:, LL) = ZH(:, LL-1) + H0(:, LL-1)*(PH(:, LL-1)-PH(:,LL))/PP(:, LL-1) 215 end DO 226 H0bis(:, LL-1) = RD * TT(:, LL-1) / RG 227 ZHbis(:, LL) = ZHbis(:, LL-1) & 228 + H0bis(:, LL-1)*(PH(:, LL-1)-PH(:,LL))/PP(:, LL-1) 229 end DO 230 ! Log pressure vert. coordinate 231 DO LL = 1, KLEV + 1 232 ZH(:, LL) = H0 * LOG(PR / (PH(:, LL) + PSEC)) 233 end DO 234 216 235 217 236 ! Winds and BV frequency … … 221 240 ! BVSEC: BV Frequency 222 241 ! VENUS ATTENTION: CP VARIABLE PSTAB CALCULE EN AMONT DES PARAMETRISATIONS 223 BV(:, LL) = SQRT(MAX(BVSEC,pn2(:,LL)))242 BV(:, LL) = MAX(BVSEC,SQRT(pn2(:,LL))) 224 243 end DO 225 244 BV(:, 1) = BV(:, 2) … … 269 288 270 289 !Online output 271 write(str2,'(i2)') NW+ 1290 write(str2,'(i2)') NW+2 272 291 outform="("//str2//"(E12.4,1X))" 273 if (output) WRITE(11,outform) ZH(IEQ, 1) / 1000., (ZO(JW, IEQ)/ZK(JW, IEQ)*COS(ZP(JW)), JW = 1, NW) 292 if (output) WRITE(11,outform) ZH(IEQ, 1) / 1000., ZHbis(IEQ, 1) / 1000., & 293 (ZO(JW, IEQ)/ZK(JW, IEQ)*COS(ZP(JW)), JW = 1, NW) 274 294 275 295 DO LL = LAUNCH, KLEV - 1 … … 300 320 ! Saturation (Eq. 12) 301 321 * ZOP(JW, :)**2 / ZK(JW, :)/BV(:, LL+1) & 302 * EXP(-ZH(:, LL + 1)/2./H0 (:,LL)) * SAT)322 * EXP(-ZH(:, LL + 1)/2./H0) * SAT) 303 323 end DO 304 324 … … 310 330 RUWP(JW, :) = ZOP(JW, :)/MAX(ABS(ZOP(JW, :)), ZOISEC)**2 & 311 331 *BV(:,LL+1)& 312 * COS(ZP(JW)) * MAX(WWP(JW, :),1e-30)**2332 * COS(ZP(JW)) * WWP(JW, :)**2 313 333 RVWP(JW, :) = ZOP(JW, :)/MAX(ABS(ZOP(JW, :)), ZOISEC)**2 & 314 334 *BV(:,LL+1)& 315 * SIN(ZP(JW)) * MAX(WWP(JW, :),1e-30)**2335 * SIN(ZP(JW)) * WWP(JW, :)**2 316 336 end DO 317 337 ! … … 324 344 end DO 325 345 !Online output 326 if (output) WRITE(11,outform) ZH(IEQ, LL + 1) / 1000., (RUWP(JW, IEQ), JW = 1, NW) 346 if (output) then 347 do JW=1,NW 348 if(RUWP(JW, IEQ).gt.0.) then 349 RUWP(JW, IEQ) = max(RUWP(JW, IEQ), 1.e-99) 350 else 351 RUWP(JW, IEQ) = min(RUWP(JW, IEQ), -1.e-99) 352 endif 353 enddo 354 WRITE(11,outform) ZH(IEQ, LL+1) / 1000., & 355 ZHbis(IEQ, LL+1) / 1000., & 356 (RUWP(JW, IEQ), JW = 1, NW) 357 endif 327 358 328 359 end DO … … 357 388 / (PH(:, LL + 1) - PH(:, LL)) * DTIME 358 389 ENDDO 390 d_t = 0. 359 391 ! ON CONSERVE LA MEMOIRE un certain temps AVEC UN SAVE 360 392 d_u = DTIME/DELTAT/REAL(NW) * d_u + (1.-DTIME/DELTAT) * d_u_sav … … 373 405 374 406 END SUBROUTINE FLOTT_GWD_RAN 407 408 !=================================================================== 409 !=================================================================== 410 !=================================================================== 411 !=================================================================== 412 413 FUNCTION ALEAS (R) 414 !***BEGIN PROLOGUE ALEAS 415 !***PURPOSE Generate a uniformly distributed random number. 416 !***LIBRARY SLATEC (FNLIB) 417 !***CATEGORY L6A21 418 !***TYPE SINGLE PRECISION (ALEAS-S) 419 !***KEYWORDS FNLIB, ALEAS NUMBER, SPECIAL FUNCTIONS, UNIFORM 420 !***AUTHOR Fullerton, W., (LANL) 421 !***DESCRIPTION 422 ! 423 ! This pseudo-random number generator is portable among a wide 424 ! variety of computers. RAND(R) undoubtedly is not as good as many 425 ! readily available installation dependent versions, and so this 426 ! routine is not recommended for widespread usage. Its redeeming 427 ! feature is that the exact same random numbers (to within final round- 428 ! off error) can be generated from machine to machine. Thus, programs 429 ! that make use of random numbers can be easily transported to and 430 ! checked in a new environment. 431 ! 432 ! The random numbers are generated by the linear congruential 433 ! method described, e.g., by Knuth in Seminumerical Methods (p.9), 434 ! Addison-Wesley, 1969. Given the I-th number of a pseudo-random 435 ! sequence, the I+1 -st number is generated from 436 ! X(I+1) = (A*X(I) + C) MOD M, 437 ! where here M = 2**22 = 4194304, C = 1731 and several suitable values 438 ! of the multiplier A are discussed below. Both the multiplier A and 439 ! random number X are represented in double precision as two 11-bit 440 ! words. The constants are chosen so that the period is the maximum 441 ! possible, 4194304. 442 ! 443 ! In order that the same numbers be generated from machine to 444 ! machine, it is necessary that 23-bit integers be reducible modulo 445 ! 2**11 exactly, that 23-bit integers be added exactly, and that 11-bit 446 ! integers be multiplied exactly. Furthermore, if the restart option 447 ! is used (where R is between 0 and 1), then the product R*2**22 = 448 ! R*4194304 must be correct to the nearest integer. 449 ! 450 ! The first four random numbers should be .0004127026, 451 ! .6750836372, .1614754200, and .9086198807. The tenth random number 452 ! is .5527787209, and the hundredth is .3600893021 . The thousandth 453 ! number should be .2176990509 . 454 ! 455 ! In order to generate several effectively independent sequences 456 ! with the same generator, it is necessary to know the random number 457 ! for several widely spaced calls. The I-th random number times 2**22, 458 ! where I=K*P/8 and P is the period of the sequence (P = 2**22), is 459 ! still of the form L*P/8. In particular we find the I-th random 460 ! number multiplied by 2**22 is given by 461 ! I = 0 1*P/8 2*P/8 3*P/8 4*P/8 5*P/8 6*P/8 7*P/8 8*P/8 462 ! RAND= 0 5*P/8 2*P/8 7*P/8 4*P/8 1*P/8 6*P/8 3*P/8 0 463 ! Thus the 4*P/8 = 2097152 random number is 2097152/2**22. 464 ! 465 ! Several multipliers have been subjected to the spectral test 466 ! (see Knuth, p. 82). Four suitable multipliers roughly in order of 467 ! goodness according to the spectral test are 468 ! 3146757 = 1536*2048 + 1029 = 2**21 + 2**20 + 2**10 + 5 469 ! 2098181 = 1024*2048 + 1029 = 2**21 + 2**10 + 5 470 ! 3146245 = 1536*2048 + 517 = 2**21 + 2**20 + 2**9 + 5 471 ! 2776669 = 1355*2048 + 1629 = 5**9 + 7**7 + 1 472 ! 473 ! In the table below LOG10(NU(I)) gives roughly the number of 474 ! random decimal digits in the random numbers considered I at a time. 475 ! C is the primary measure of goodness. In both cases bigger is better. 476 ! 477 ! LOG10 NU(I) C(I) 478 ! A I=2 I=3 I=4 I=5 I=2 I=3 I=4 I=5 479 ! 480 ! 3146757 3.3 2.0 1.6 1.3 3.1 1.3 4.6 2.6 481 ! 2098181 3.3 2.0 1.6 1.2 3.2 1.3 4.6 1.7 482 ! 3146245 3.3 2.2 1.5 1.1 3.2 4.2 1.1 0.4 483 ! 2776669 3.3 2.1 1.6 1.3 2.5 2.0 1.9 2.6 484 ! Best 485 ! Possible 3.3 2.3 1.7 1.4 3.6 5.9 9.7 14.9 486 ! 487 ! Input Argument -- 488 ! R If R=0., the next random number of the sequence is generated. 489 ! If R .LT. 0., the last generated number will be returned for 490 ! possible use in a restart procedure. 491 ! If R .GT. 0., the sequence of random numbers will start with 492 ! the seed R mod 1. This seed is also returned as the value of 493 ! RAND provided the arithmetic is done exactly. 494 ! 495 ! Output Value -- 496 ! RAND a pseudo-random number between 0. and 1. 497 ! 498 !***REFERENCES (NONE) 499 !***ROUTINES CALLED (NONE) 500 !***REVISION HISTORY (YYMMDD) 501 ! 770401 DATE WRITTEN 502 ! 890531 Changed all specific intrinsics to generic. (WRB) 503 ! 890531 REVISION DATE from Version 3.2 504 ! 891214 Prologue converted to Version 4.0 format. (BAB) 505 !***END PROLOGUE RAND 506 SAVE IA1, IA0, IA1MA0, IC, IX1, IX0 507 DATA IA1, IA0, IA1MA0 /1536, 1029, 507/ 508 DATA IC /1731/ 509 DATA IX1, IX0 /0, 0/ 510 !***FIRST EXECUTABLE STATEMENT RAND 511 ! 512 ! A*X = 2**22*IA1*IX1 + 2**11*(IA1*IX1 + (IA1-IA0)*(IX0-IX1) 513 ! + IA0*IX0) + IA0*IX0 514 ! 515 IF (R.EQ.0.) THEN 516 IY0 = IA0*IX0 517 IY1 = IA1*IX1 + IA1MA0*(IX0-IX1) + IY0 518 IY0 = IY0 + IC 519 IX0 = MOD (IY0, 2048) 520 IY1 = IY1 + (IY0-IX0)/2048 521 IX1 = MOD (IY1, 2048) 522 ENDIF 523 524 IF (R.GT.0.) THEN 525 IX1 = MOD(R,1.)*4194304. + 0.5 526 IX0 = MOD (IX1, 2048) 527 IX1 = (IX1-IX0)/2048 528 ENDIF 529 530 ALEAS = IX1*2048 + IX0 531 ALEAS = ALEAS / 4194304. 532 RETURN 533 534 END 535 536 -
trunk/LMDZ.VENUS/libf/phyvenus/grid_noro.F
r800 r808 7 7 . imar, jmar, x, y, 8 8 . zphi,zmea,zstd,zsig,zgam,zthe, 9 . zpic,zval ,mask)9 . zpic,zval) 10 10 c======================================================================= 11 11 c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead) … … 40 40 c xdata, ydata: coordinates X and Y input field 41 41 c zdata: Input field 42 c In this version it is assumed that the entry data come from43 c the USNavy dataset: imdep=iusn=2160, jmdep=jusn=1080.44 42 c OUTPUT: 45 43 c imar, jmar: dimensions X and Y Output field … … 57 55 IMPLICIT REAL(X,Z) 58 56 59 parameter(iusn=2160,jusn=1080,iext=216, epsfra = 1.e-5)60 57 #include "dimensions.h" 61 REAL xusn(iusn+2*iext),yusn(jusn+2)62 REAL zusn(iusn+2*iext,jusn+2)63 58 64 59 INTEGER imdep, jmdep … … 67 62 c 68 63 INTEGER imar, jmar 64 c parametres lies au fichier d entree... A documenter... 65 parameter(iext=216, epsfra = 1.e-5) 66 REAL xusn(imdep+2*iext),yusn(jmdep+2) 67 REAL zusn(imdep+2*iext,jmdep+2) 69 68 70 69 C INTERMEDIATE FIELDS (CORRELATIONS OF OROGRAPHY GRADIENT) … … 76 75 C CORRELATIONS OF USN OROGRAPHY GRADIENTS 77 76 78 REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2) 79 REAL zxtzyusn(iusn+2*iext,jusn+2) 77 REAL zxtzxusn(imdep+2*iext,jmdep+2) 78 REAL zytzyusn(imdep+2*iext,jmdep+2) 79 REAL zxtzyusn(imdep+2*iext,jmdep+2) 80 80 REAL x(imar+1),y(jmar),zphi(imar+1,jmar) 81 81 REAL zmea(imar+1,jmar),zstd(imar+1,jmar) 82 REAL zmea0(imar+1,jmar) ! GK211005 (CG)83 82 REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar) 84 83 REAL zpic(imar+1,jmar),zval(imar+1,jmar) 85 cx$$ PB integer mask(imar+1,jmar)86 real mask(imar+1,jmar), mask_tmp(imar+1,jmar)87 84 real num_tot(2200,1100),num_lan(2200,1100) 88 85 c 89 86 REAL a(2200),b(2200),c(1100),d(1100) 90 logical masque_lu91 87 c 92 88 print *,' parametres de l orographie a l echelle sous maille' 93 89 xpi=acos(-1.) 94 90 rad = 6 371 229. 95 zdeltay=2.*xpi/REAL(jusn)*rad 96 c 97 c utilise-t'on un masque lu? 98 c 99 masque_lu = .true. 100 if (maxval(mask) == -99999 .and. minval(mask) == -99999) then 101 masque_lu= .false. 102 masque = 0.0 103 endif 104 write(*,*)'Masque lu', masque_lu 91 zdeltay=2.*xpi/REAL(jmdep)*rad 105 92 c 106 93 c quelques tests de dimensions: … … 114 101 ENDIF 115 102 116 IF(imdep.ne.iusn.or.jmdep.ne.jusn)then117 print *,' imdep or jmdep bad dimensions:',imdep,jmdep118 call abort119 ENDIF120 121 103 IF(imar+1.ne.iim+1.or.jmar.ne.jjm+1)THEN 122 104 print *,' imar or jmar bad dimensions:',imar,jmar … … 133 115 C BOUNDARIES: 134 116 c 135 DO j=1,j usn117 DO j=1,jmdep 136 118 yusn(j+1)=ydata(j) 137 DO i=1,i usn119 DO i=1,imdep 138 120 zusn(i+iext,j+1)=zdata(i,j) 139 121 xusn(i+iext)=xdata(i) 140 122 ENDDO 141 123 DO i=1,iext 142 zusn(i,j+1)=zdata(i usn-iext+i,j)143 xusn(i)=xdata(i usn-iext+i)-2.*xpi144 zusn(i usn+iext+i,j+1)=zdata(i,j)145 xusn(i usn+iext+i)=xdata(i)+2.*xpi124 zusn(i,j+1)=zdata(imdep-iext+i,j) 125 xusn(i)=xdata(imdep-iext+i)-2.*xpi 126 zusn(imdep+iext+i,j+1)=zdata(i,j) 127 xusn(imdep+iext+i)=xdata(i)+2.*xpi 146 128 ENDDO 147 129 ENDDO 148 130 149 131 yusn(1)=ydata(1)+(ydata(1)-ydata(2)) 150 yusn(j usn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))151 DO i=1,i usn/2+iext152 zusn(i,1)=zusn(i+i usn/2,2)153 zusn(i+i usn/2+iext,1)=zusn(i,2)154 zusn(i,j usn+2)=zusn(i+iusn/2,jusn+1)155 zusn(i+i usn/2+iext,jusn+2)=zusn(i,jusn+1)132 yusn(jmdep+2)=ydata(jmdep)+(ydata(jmdep)-ydata(jmdep-1)) 133 DO i=1,imdep/2+iext 134 zusn(i,1)=zusn(i+imdep/2,2) 135 zusn(i+imdep/2+iext,1)=zusn(i,2) 136 zusn(i,jmdep+2)=zusn(i+imdep/2,jmdep+1) 137 zusn(i+imdep/2+iext,jmdep+2)=zusn(i,jmdep+1) 156 138 ENDDO 157 139 c … … 194 176 c COMPUTE SLOPES CORRELATIONS ON USN GRID 195 177 c 196 DO j = 1,j usn+2197 DO i = 1, i usn+2*iext178 DO j = 1,jmdep+2 179 DO i = 1, imdep+2*iext 198 180 zytzyusn(i,j)=0.0 199 181 zxtzxusn(i,j)=0.0 … … 203 185 204 186 205 DO j = 2,j usn+1187 DO j = 2,jmdep+1 206 188 zdeltax=zdeltay*cos(yusn(j)) 207 DO i = 2, i usn+2*iext-1189 DO i = 2, imdep+2*iext-1 208 190 zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2 209 191 zxtzxusn(i,j)=(zusn(i+1,j)-zusn(i-1,j))**2/zdeltax**2 … … 215 197 c SUMMATION OVER GRIDPOINT AREA 216 198 c 217 zleny=xpi/REAL(j usn)*rad218 xincr=xpi/2./REAL(j usn)199 zleny=xpi/REAL(jmdep)*rad 200 xincr=xpi/2./REAL(jmdep) 219 201 DO ii = 1, imar+1 220 202 DO jj = 1, jmar … … 222 204 num_lan(ii,jj)=0. 223 205 c PRINT *,' iteration ii jj:',ii,jj 224 DO j = 2,j usn+1225 c DO j = 3,j usn206 DO j = 2,jmdep+1 207 c DO j = 3,jmdep 226 208 zlenx=zleny*cos(yusn(j)) 227 209 zdeltax=zdeltay*cos(yusn(j)) … … 231 213 * amin1(zbordnor,zbordsud,zleny)) 232 214 IF(weighy.ne.0)THEN 233 DO i = 2, i usn+2*iext-1215 DO i = 2, imdep+2*iext-1 234 216 zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j)) 235 217 zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j)) … … 273 255 DO jj = 1, jmar 274 256 IF (weight(ii,jj) .NE. 0.0) THEN 275 c Mask276 cx$$ if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then277 cx$$ mask(ii,jj)=1278 cx$$ else279 cx$$ mask(ii,jj)=0280 cx$$ ENDIF281 if (.not. masque_lu) then282 mask(ii,jj) = num_lan(ii,jj)/num_tot(ii,jj)283 endif284 257 c Mean Orography: 285 258 zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj) … … 311 284 C FIRST FILTER, MOVING AVERAGE OVER 9 POINTS. 312 285 313 zmea0(:,:) = zmea(:,:) ! GK211005 (CG) on sauvegarde la topo non lissee314 286 CALL MVA9(zmea,iim+1,jjm+1) 315 287 CALL MVA9(zstd,iim+1,jjm+1) … … 319 291 CALL MVA9(zxtzy,iim+1,jjm+1) 320 292 CALL MVA9(zytzy,iim+1,jjm+1) 321 Cx$$ Masque prenant en compte maximum de terre322 Cx$$ On seuil a 10% de terre de terre car en dessous les parametres de surface n'on323 Cx$$ pas de sens (PB)324 mask_tmp= 0.0325 WHERE(mask .GE. 0.1) mask_tmp = 1.326 293 327 294 DO ii = 1, imar … … 339 306 if(abs(xm).le.xw) xm=xw*sign(1.,xm) 340 307 c slope: 341 cx$$ zsig(ii,jj)=sqrt(xq)*mask(ii,jj) 342 cx$$c isotropy: 343 cx$$ zgam(ii,jj)=xp/xq*mask(ii,jj) 344 cx$$c angle theta: 345 cx$$ zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj) 346 cx$$ zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj) 347 cx$$ zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj) 348 cx$$ zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj) 349 cx$$ zval(ii,jj)=zval(ii,jj)*mask(ii,jj) 350 cx$$ zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj) 351 Cx$* PB modif pour maque de terre fractionnaire 352 c slope: 353 zsig(ii,jj)=sqrt(xq)*mask_tmp(ii,jj) 308 zsig(ii,jj)=sqrt(xq) 354 309 c isotropy: 355 zgam(ii,jj)=xp/xq *mask_tmp(ii,jj)310 zgam(ii,jj)=xp/xq 356 311 c angle theta: 357 zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask_tmp(ii,jj) 358 ! GK211005 (CG) ne pas forcement lisser la topo 359 ! zphi(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj) 360 zphi(ii,jj)=zmea0(ii,jj)*mask_tmp(ii,jj) 312 zthe(ii,jj)=57.29577951*atan2(xm,xl)/2. 313 zphi(ii,jj)=zmea(ii,jj) 361 314 ! 362 zmea(ii,jj)=zmea(ii,jj) *mask_tmp(ii,jj)363 zpic(ii,jj)=zpic(ii,jj) *mask_tmp(ii,jj)364 zval(ii,jj)=zval(ii,jj) *mask_tmp(ii,jj)365 zstd(ii,jj)=zstd(ii,jj) *mask_tmp(ii,jj)315 zmea(ii,jj)=zmea(ii,jj) 316 zpic(ii,jj)=zpic(ii,jj) 317 zval(ii,jj)=zval(ii,jj) 318 zstd(ii,jj)=zstd(ii,jj) 366 319 c print 101,ii,jj, 367 320 c * zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj), … … 385 338 print *,' PENTE:',zllmsig 386 339 print *,' ANISOTROP:',zllmgam 387 print *,' ANGLE:',zminthe,zllmthe 340 print *,' ANGLE:',zminthe,zllmthe 388 341 print *,' pic:',zllmpic 389 342 print *,' val:',zllmval -
trunk/LMDZ.VENUS/libf/phyvenus/gwprofil.F
r101 r808 151 151 zriw=pri(jl,jk)*(1.-zalfa)/(1+zalfa*zsqr)**2 152 152 if(zriw.lt.grcrit) then 153 C print *,' breaking!!!',ptau(jl,jk) 153 c print *,' breaking!!!',ptau(jl,jk),zsqr 154 154 zdel=4./zsqr/grcrit+1./grcrit**2+4./grcrit 155 155 zb=1./grcrit+2./zsqr -
trunk/LMDZ.VENUS/libf/phyvenus/ini_histday.h
r97 r808 5 5 c 6 6 zsto = dtime 7 zout = dtime * FLOAT(ecrit_day)8 zsto1= dtime * FLOAT(ecrit_day)7 zout = dtime * REAL(ecrit_day) 8 zsto1= dtime * REAL(ecrit_day) 9 9 c 10 10 idayref = day_ref -
trunk/LMDZ.VENUS/libf/phyvenus/ini_histrac.h
r3 r808 21 21 . klev, zpresnivs, nvert) 22 22 23 zout = pdtphys * FLOAT(ecrit_tra)23 zout = pdtphys * REAL(ecrit_tra) 24 24 c 25 25 CALL histdef(nid_tra, "phis", "Surface geop. height", "-", -
trunk/LMDZ.VENUS/libf/phyvenus/lw_venus_ve.F
r101 r808 115 115 116 116 c calcul direct OU calcul par schema implicit 117 if (1.eq. 0) then117 if (1.eq.1) then 118 118 do j=1,kflev 119 119 ! ADAPTATION GCM POUR CP(T) -
trunk/LMDZ.VENUS/libf/phyvenus/physiq.F
r175 r808 527 527 ENDIF 528 528 c 529 IF (dtime* FLOAT(radpas).GT.(RDAY*0.25).AND.cycle_diurne)529 IF (dtime*REAL(radpas).GT.(RDAY*0.25).AND.cycle_diurne) 530 530 $ THEN 531 531 WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant' … … 718 718 719 719 IF (cycle_diurne) THEN 720 zdtime=dtime* FLOAT(radpas) ! pas de temps du rayonnement (s)720 zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s) 721 721 CALL zenang(zlongi,gmtime,zdtime,rlatd,rlond,rmu0,fract) 722 722 ELSE … … 781 781 782 782 ! ADAPTATION GCM POUR CP(T) 783 783 784 CALL clmain(dtime,itap, 784 785 e t_seri,u_seri,v_seri, … … 951 952 c $ ' (itaprad=',itaprad,'/radpas=',radpas,')' 952 953 953 dtimerad = dtime* FLOAT(radpas) ! pas de temps du rayonnement (s)954 dtimerad = dtime*REAL(radpas) ! pas de temps du rayonnement (s) 954 955 c PRINT*,'dtimerad,dtime,radpas',dtimerad,dtime,radpas 955 956 … … 958 959 c print*,"sollw avant radlwsw=",sollw(klon/2) 959 960 c print*,"avant radlwsw" 961 960 962 CALL radlwsw 961 963 e (dist, rmu0, fract, … … 965 967 s sollwdown, 966 968 s lwnet, swnet) 969 967 970 c print*,"apres radlwsw" 968 969 971 c print*,"radsol apres radlwsw=",radsol(klon/2) 970 972 c print*,"solsw apres radlwsw=",solsw(klon/2) … … 1027 1029 zn2(i,k) = max(zn2(i,k),1.e-12) ! securite 1028 1030 enddo 1031 zn2(i,1) = 1.e-12 ! securite 1029 1032 enddo 1030 1033 … … 1055 1058 s d_t_oro, d_u_oro, d_v_oro) 1056 1059 1060 c print*,"d_u_oro=",d_u_oro(klon/2,:) 1057 1061 c ajout des tendances 1058 1062 t_seri(:,:) = t_seri(:,:) + d_t_oro(:,:) … … 1074 1078 c ----------------------------OROLIFT 1075 1079 IF (ok_orolf) THEN 1080 print*,"ok_orolf NOT IMPLEMENTED !" 1081 stop 1076 1082 c 1077 1083 c selection des points pour lesquels le shema est actif: … … 1380 1386 ENDIF 1381 1387 1382 1383 1388 RETURN 1384 1389 END -
trunk/LMDZ.VENUS/libf/phyvenus/readstartphy.F
r778 r808 8 8 . albe, solsw, sollw, 9 9 . fder,radsol, 10 . zmea, zstd, zsig, zgam, zthe, zpic, zval, 10 11 . tabcntr0) 11 12 c====================================================================== … … 35 36 real solsw(ngridmx) 36 37 real fder(ngridmx) 38 REAL zmea(ngridmx), zstd(ngridmx) 39 REAL zsig(ngridmx), zgam(ngridmx), zthe(ngridmx) 40 REAL zpic(ngridmx), zval(ngridmx) 37 41 INTEGER length 38 42 PARAMETER (length=100) … … 294 298 ENDDO 295 299 PRINT*,'Rayonnement net au sol radsol:', xmin, xmax 300 301 c 302 c Lecture des parametres orographie sous-maille: 303 c 304 ierr = NF_INQ_VARID (nid, "ZMEA", nvarid) 305 IF (ierr.NE.NF_NOERR) THEN 306 PRINT*, 'phyetat0: Le champ <ZMEA> est absent' 307 PRINT*, 'mis a zero' 308 zmea = 0. 309 ELSE 310 #ifdef NC_DOUBLE 311 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea) 312 #else 313 ierr = NF_GET_VAR_REAL(nid, nvarid, zmea) 314 #endif 315 IF (ierr.NE.NF_NOERR) THEN 316 PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>' 317 CALL abort 318 ENDIF 319 ENDIF 320 xmin = 1.0E+20 321 xmax = -1.0E+20 322 DO i = 1, ngridmx 323 xmin = MIN(zmea(i),xmin) 324 xmax = MAX(zmea(i),xmax) 325 ENDDO 326 PRINT*,'zmea:', xmin, xmax 327 c 328 ierr = NF_INQ_VARID (nid, "ZSTD", nvarid) 329 IF (ierr.NE.NF_NOERR) THEN 330 PRINT*, 'phyetat0: Le champ <ZSTD> est absent' 331 PRINT*, 'mis a zero' 332 zstd = 0. 333 ELSE 334 #ifdef NC_DOUBLE 335 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd) 336 #else 337 ierr = NF_GET_VAR_REAL(nid, nvarid, zstd) 338 #endif 339 IF (ierr.NE.NF_NOERR) THEN 340 PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>' 341 CALL abort 342 ENDIF 343 ENDIF 344 xmin = 1.0E+20 345 xmax = -1.0E+20 346 DO i = 1, ngridmx 347 xmin = MIN(zstd(i),xmin) 348 xmax = MAX(zstd(i),xmax) 349 ENDDO 350 PRINT*,'zstd:', xmin, xmax 351 c 352 ierr = NF_INQ_VARID (nid, "ZSIG", nvarid) 353 IF (ierr.NE.NF_NOERR) THEN 354 PRINT*, 'phyetat0: Le champ <ZSIG> est absent' 355 PRINT*, 'mis a zero' 356 zsig = 0. 357 ELSE 358 #ifdef NC_DOUBLE 359 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig) 360 #else 361 ierr = NF_GET_VAR_REAL(nid, nvarid, zsig) 362 #endif 363 IF (ierr.NE.NF_NOERR) THEN 364 PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>' 365 CALL abort 366 ENDIF 367 ENDIF 368 xmin = 1.0E+20 369 xmax = -1.0E+20 370 DO i = 1, ngridmx 371 xmin = MIN(zsig(i),xmin) 372 xmax = MAX(zsig(i),xmax) 373 ENDDO 374 PRINT*,'zsig:', xmin, xmax 375 c 376 ierr = NF_INQ_VARID (nid, "ZGAM", nvarid) 377 IF (ierr.NE.NF_NOERR) THEN 378 PRINT*, 'phyetat0: Le champ <ZGAM> est absent' 379 PRINT*, 'mis a zero' 380 zgam = 0. 381 ELSE 382 #ifdef NC_DOUBLE 383 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam) 384 #else 385 ierr = NF_GET_VAR_REAL(nid, nvarid, zgam) 386 #endif 387 IF (ierr.NE.NF_NOERR) THEN 388 PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>' 389 CALL abort 390 ENDIF 391 ENDIF 392 xmin = 1.0E+20 393 xmax = -1.0E+20 394 DO i = 1, ngridmx 395 xmin = MIN(zgam(i),xmin) 396 xmax = MAX(zgam(i),xmax) 397 ENDDO 398 PRINT*,'zgam:', xmin, xmax 399 c 400 ierr = NF_INQ_VARID (nid, "ZTHE", nvarid) 401 IF (ierr.NE.NF_NOERR) THEN 402 PRINT*, 'phyetat0: Le champ <ZTHE> est absent' 403 PRINT*, 'mis a zero' 404 zthe = 0. 405 ELSE 406 #ifdef NC_DOUBLE 407 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe) 408 #else 409 ierr = NF_GET_VAR_REAL(nid, nvarid, zthe) 410 #endif 411 IF (ierr.NE.NF_NOERR) THEN 412 PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>' 413 CALL abort 414 ENDIF 415 ENDIF 416 xmin = 1.0E+20 417 xmax = -1.0E+20 418 DO i = 1, ngridmx 419 xmin = MIN(zthe(i),xmin) 420 xmax = MAX(zthe(i),xmax) 421 ENDDO 422 PRINT*,'zthe:', xmin, xmax 423 c 424 ierr = NF_INQ_VARID (nid, "ZPIC", nvarid) 425 IF (ierr.NE.NF_NOERR) THEN 426 PRINT*, 'phyetat0: Le champ <ZPIC> est absent' 427 PRINT*, 'mis a zero' 428 zpic = 0. 429 ELSE 430 #ifdef NC_DOUBLE 431 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic) 432 #else 433 ierr = NF_GET_VAR_REAL(nid, nvarid, zpic) 434 #endif 435 IF (ierr.NE.NF_NOERR) THEN 436 PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>' 437 CALL abort 438 ENDIF 439 ENDIF 440 xmin = 1.0E+20 441 xmax = -1.0E+20 442 DO i = 1, ngridmx 443 xmin = MIN(zpic(i),xmin) 444 xmax = MAX(zpic(i),xmax) 445 ENDDO 446 PRINT*,'zpic:', xmin, xmax 447 c 448 ierr = NF_INQ_VARID (nid, "ZVAL", nvarid) 449 IF (ierr.NE.NF_NOERR) THEN 450 PRINT*, 'phyetat0: Le champ <ZVAL> est absent' 451 PRINT*, 'mis a zero' 452 zval = 0. 453 ELSE 454 #ifdef NC_DOUBLE 455 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval) 456 #else 457 ierr = NF_GET_VAR_REAL(nid, nvarid, zval) 458 #endif 459 IF (ierr.NE.NF_NOERR) THEN 460 PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>' 461 CALL abort 462 ENDIF 463 ENDIF 464 xmin = 1.0E+20 465 xmax = -1.0E+20 466 DO i = 1, ngridmx 467 xmin = MIN(zval(i),xmin) 468 xmax = MAX(zval(i),xmax) 469 ENDDO 470 PRINT*,'zval:', xmin, xmax 296 471 c 297 472 c Fermer le fichier: … … 301 476 RETURN 302 477 END 478 -
trunk/LMDZ.VENUS/libf/phyvenus/startvar.F90
r800 r808 49 49 ! all in LMDZ. A convention is required. 50 50 !------------------------------------------------------------------------------- 51 #ifdef CPP_EARTH52 51 USE ioipsl 53 52 IMPLICIT NONE … … 69 68 REAL, DIMENSION(:), ALLOCATABLE, TARGET, SAVE :: levdyn_ini 70 69 REAL, DIMENSION(:,:), ALLOCATABLE, TARGET, SAVE :: relief, zstd, zsig, zgam 71 REAL, DIMENSION(:,:), ALLOCATABLE, TARGET, SAVE :: masque,zthe, zpic, zval70 REAL, DIMENSION(:,:), ALLOCATABLE, TARGET, SAVE :: zthe, zpic, zval 72 71 REAL, DIMENSION(:,:), ALLOCATABLE, TARGET, SAVE :: rugo, phis, tsol, qsol 73 72 REAL, DIMENSION(:,:), ALLOCATABLE, TARGET, SAVE :: psol_dyn … … 170 169 ! 171 170 SUBROUTINE startget_phys2d(varname, iml, jml, lon_in, lat_in, champ, val_exp, & 172 jml2, lon_in2, lat_in2 , ibar , msk)171 jml2, lon_in2, lat_in2 , ibar) 173 172 ! 174 173 !------------------------------------------------------------------------------- … … 187 186 REAL, DIMENSION(jml2), INTENT(IN) :: lat_in2 188 187 LOGICAL, INTENT(IN) :: ibar 189 REAL, DIMENSION(iml,jml), INTENT(IN), OPTIONAL :: msk190 188 !------------------------------------------------------------------------------- 191 189 ! Local variables: 192 190 #include "iniprint.h" 193 191 REAL, DIMENSION(:,:), POINTER :: v2d=>NULL() 194 LOGICAL :: lrelief1, lrelief2195 192 !------------------------------------------------------------------------------- 196 193 v2d=>NULL() 197 lrelief1=(.NOT.ALLOCATED(relief).AND. PRESENT(msk))198 lrelief2=(.NOT.ALLOCATED(relief).AND..NOT.PRESENT(msk))199 194 IF(MINVAL(champ)==MAXVAL(champ).AND.MINVAL(champ)==val_exp) THEN 200 195 … … 205 200 CALL start_init_dyn (iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar) 206 201 CASE('relief') 207 IF(lrelief1) CALL start_init_orog(iml,jml,lon_in,lat_in,msk) 208 IF(lrelief2) CALL start_init_orog(iml,jml,lon_in,lat_in) 202 IF(.NOT.ALLOCATED(relief)) CALL start_init_orog(iml,jml,lon_in,lat_in) 209 203 CASE('surfgeo') 210 204 IF(.NOT.ALLOCATED(phis)) CALL start_init_orog(iml,jml,lon_in,lat_in) 211 CASE('rugosite' ,'masque')205 CASE('rugosite') 212 206 IF(.NOT.ALLOCATED(rugo)) CALL start_init_orog(iml,jml,lon_in,lat_in) 213 207 CASE DEFAULT … … 222 216 CASE('relief'); v2d=>relief 223 217 CASE('rugosite'); v2d=>rugo 224 CASE('masque'); v2d=>masque225 218 CASE('surfgeo'); v2d=>phis 226 219 END SELECT … … 369 362 !------------------------------------------------------------------------------- 370 363 ! 371 SUBROUTINE start_init_orog(iml,jml,lon_in,lat_in ,masque_lu)364 SUBROUTINE start_init_orog(iml,jml,lon_in,lat_in) 372 365 ! 373 366 !------------------------------------------------------------------------------- … … 376 369 REAL, DIMENSION(iml), INTENT(IN) :: lon_in 377 370 REAL, DIMENSION(jml), INTENT(IN) :: lat_in 378 REAL, DIMENSION(iml,jml), INTENT(IN), OPTIONAL :: masque_lu379 371 !------------------------------------------------------------------------------- 380 372 ! Local variables: 381 373 #include "iniprint.h" 374 #include "comconst.h" 382 375 CHARACTER(LEN=25) :: title 383 376 CHARACTER(LEN=120) :: orofname … … 426 419 ALLOCATE(zval(iml,jml)) ! Hauteur vallees de la SSO 427 420 ALLOCATE(relief(iml,jml)) ! Orographie moyenne 428 ALLOCATE(masque(iml,jml)) ! Masque terre ocean429 masque = -99999.430 IF(PRESENT(masque_lu)) masque=masque_lu431 421 432 422 CALL grid_noro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi, iml-1, jml, & 433 lon_in, lat_in, phis, relief, zstd, zsig, zgam, zthe, zpic, zval , masque)434 phis = phis * 9.81423 lon_in, lat_in, phis, relief, zstd, zsig, zgam, zthe, zpic, zval) 424 phis = phis * g 435 425 436 426 !--- SURFACE ROUGHNESS COMPUTATION (UNUSED FOR THE MOMENT !!! ) … … 776 766 !------------------------------------------------------------------------------- 777 767 778 #endif779 ! of #ifdef CPP_EARTH780 781 768 END MODULE startvar 782 769 ! -
trunk/LMDZ.VENUS/libf/phyvenus/write_histday.h
r97 r808 13 13 c 14 14 zsto = dtime 15 zout = dtime * FLOAT(ecrit_day)15 zout = dtime * REAL(ecrit_day) 16 16 itau_w = itau_phy + itap 17 17 -
trunk/LMDZ.VENUS/libf/phyvenus/write_histrac.h
r3 r808 7 7 c 8 8 zsto = pdtphys 9 zout = pdtphys * FLOAT(ecrit_tra)9 zout = pdtphys * REAL(ecrit_tra) 10 10 itau_w = itau_phy + nstep 11 11 -
trunk/LMDZ.VENUS/libf/phyvenus/writerestartphy.F
r779 r808 4 4 . solsw, sollw,fder, 5 5 . radsol, 6 . zmea, zstd, zsig, zgam, zthe, zpic, zval, 6 7 . t_ancien) 7 8 … … 27 28 real fder(klon) 28 29 REAL radsol(klon) 30 REAL zmea(klon), zstd(klon) 31 REAL zsig(klon), zgam(klon), zthe(klon) 32 REAL zpic(klon), zval(klon) 29 33 REAL t_ancien(klon,klev) 30 34 c … … 218 222 ierr = NF_REDEF (nid) 219 223 #ifdef NC_DOUBLE 224 ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid) 225 #else 226 ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid) 227 #endif 228 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 229 . "zmea Orographie sous-maille") 230 ierr = NF_ENDDEF(nid) 231 #ifdef NC_DOUBLE 232 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea) 233 #else 234 ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea) 235 #endif 236 c 237 ierr = NF_REDEF (nid) 238 #ifdef NC_DOUBLE 239 ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid) 240 #else 241 ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid) 242 #endif 243 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 244 . "zstd Orographie sous-maille") 245 ierr = NF_ENDDEF(nid) 246 #ifdef NC_DOUBLE 247 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd) 248 #else 249 ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd) 250 #endif 251 c 252 ierr = NF_REDEF (nid) 253 #ifdef NC_DOUBLE 254 ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid) 255 #else 256 ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid) 257 #endif 258 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 259 . "zsig Orographie sous-maille") 260 ierr = NF_ENDDEF(nid) 261 #ifdef NC_DOUBLE 262 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig) 263 #else 264 ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig) 265 #endif 266 c 267 ierr = NF_REDEF (nid) 268 #ifdef NC_DOUBLE 269 ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid) 270 #else 271 ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid) 272 #endif 273 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 274 . "zgam Orographie sous-maille") 275 ierr = NF_ENDDEF(nid) 276 #ifdef NC_DOUBLE 277 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam) 278 #else 279 ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam) 280 #endif 281 c 282 ierr = NF_REDEF (nid) 283 #ifdef NC_DOUBLE 284 ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid) 285 #else 286 ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid) 287 #endif 288 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 289 . "zthe Orographie sous-maille") 290 ierr = NF_ENDDEF(nid) 291 #ifdef NC_DOUBLE 292 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe) 293 #else 294 ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe) 295 #endif 296 c 297 ierr = NF_REDEF (nid) 298 #ifdef NC_DOUBLE 299 ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid) 300 #else 301 ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid) 302 #endif 303 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 304 . "zpic Orographie sous-maille") 305 ierr = NF_ENDDEF(nid) 306 #ifdef NC_DOUBLE 307 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zpic) 308 #else 309 ierr = NF_PUT_VAR_REAL (nid,nvarid,zpic) 310 #endif 311 c 312 ierr = NF_REDEF (nid) 313 #ifdef NC_DOUBLE 314 ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid) 315 #else 316 ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid) 317 #endif 318 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 319 . "zval Orographie sous-maille") 320 ierr = NF_ENDDEF(nid) 321 #ifdef NC_DOUBLE 322 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zval) 323 #else 324 ierr = NF_PUT_VAR_REAL (nid,nvarid,zval) 325 #endif 326 c 327 ierr = NF_REDEF (nid) 328 #ifdef NC_DOUBLE 220 329 ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid) 221 330 #else -
trunk/UTIL/NCL/help.txt
r500 r808 46 46 47 47 Default: liste => list the variables in file 48 49 If varname = customvar then a user-defined variable can be plotted 50 with -v customvar,labelvar 51 This labelvar must be defined in the customVar routine in visu-utils.ncl 48 52 49 53 [-v2 varname] : Variable name to be overplotted -
trunk/UTIL/NCL/planeto.ncl
r500 r808 28 28 tname=liste(i) 29 29 end if 30 if ((liste(i).eq."lev").or.(liste(i).eq."presnivs") ) then30 if ((liste(i).eq."lev").or.(liste(i).eq."presnivs").or.(liste(i).eq."levgrnd")) then 31 31 pname=liste(i) 32 32 end if … … 86 86 ;---- load variable(s) 87 87 ;--------------------- 88 variable=infile->$var$ 89 nbdim=dimsizes(filevardimsizes(infile,var)) 90 88 89 if (var.ne."custom") then 90 variable=infile->$var$ 91 nbdim=dimsizes(filevardimsizes(infile,var)) 92 else 93 variable=customVar(infile,labelvar) 94 nbdim=dimsizes(dimsizes(variable)) 95 end if 96 91 97 overplot=False 92 98 diffdims=False -
trunk/UTIL/NCL/visu-ncl
r500 r808 1 1 #!/bin/bash 2 2 3 # Directory where the NCL files are located ** EDIT **3 # Directory where the NCL files are located ** EDIT ** 4 4 5 5 export NCLDIR=~/LMDZ5/UTIL/NCL … … 11 11 inFile="nofile" 12 12 var="liste" 13 labelvar="dummy" 13 14 var2="dummy" 14 15 media="x11" … … 56 57 inFile=$2 ; shift ; shift ;; 57 58 "-v") 58 var=$2 ; shift ; shift ;; 59 var=${2%%,*} 60 tmp=${2#*,} 61 labelvar=${tmp%%,*} 62 if [ $labelvar != $var ]; then 63 labelvar=${tmp#*,} 64 fi 65 shift ; shift ;; 59 66 "-v2") 60 67 var2=$2 ; shift ; shift ;; … … 190 197 ncl inFile=\"$inFile\" \ 191 198 var=\"$var\" \ 199 labelvar=\"$labelvar\" \ 192 200 var2=\"$var2\" \ 193 201 media=\"$media\" \ … … 220 228 planeto.ncl 221 229 222 if [ -f *pdf ]; then 230 if [ -f *pdf ]; then 223 231 mv *pdf $SIMUDIR 224 232 fi 225 233 226 if [ -f *ps ]; then 234 if [ -f *ps ]; then 227 235 mv *ps $SIMUDIR 228 236 fi -
trunk/UTIL/NCL/visu-utils.ncl
r497 r808 56 56 if (nbdim.eq.4) then 57 57 vartrim=var({$dimname(0)$|mindimval(0):maxdimval(0)},{$dimname(1)$|mindimval(1):maxdimval(1)},{$dimname(2)$|mindimval(2):maxdimval(2)},{$dimname(3)$|mindimval(3):maxdimval(3)}) 58 ; vartrim=var($dimname(0)$|0:0,{$dimname(1)$|mindimval(1):maxdimval(1)},{$dimname(2)$|mindimval(2):maxdimval(2)},{$dimname(3)$|mindimval(3):maxdimval(3)}) 58 59 end if 59 60 … … 628 629 end 629 630 631 ;;;;;;;;;;;; customVar ;;;;;;;;;;;;;;;; 632 633 undef("customVar") 634 function customVar(infile,labelvar) 635 ;============================ 636 637 ; infile : input file 638 ; labelvar : input label for variable 639 640 ; THIS IS TO BE CUSTOMIZED EACH TIME ACCORDING TO YOUR NEEDS 641 ; because it is impossible to make it automatic... 642 643 begin 644 645 prepared = "dummy" ; DEFAULT 646 647 if (labelvar.eq."dTdyn") then 648 if (isfilevar(infile,"vitu")) then 649 dtdyn = infile->dtdyn 650 else 651 dtdyn = infile->DTCORE 652 end if 653 myvar = dtdyn*1e7 654 copy_VarMeta(dtdyn,myvar) 655 myvar@units ="K/Vd" 656 myvar@long_name="Dynamics heating rate" 657 prepared = labelvar 658 end if 659 660 if (labelvar.eq."dTadj") then 661 if (isfilevar(infile,"vitu")) then 662 dtadj = infile->dtajs 663 else 664 dtadj = infile->DADJ 665 end if 666 myvar = dtadj*1e7 667 copy_VarMeta(dtadj,myvar) 668 myvar@units ="K/Vd" 669 myvar@long_name="Dry convection heating rate" 670 prepared = labelvar 671 end if 672 673 if (labelvar.eq."dTvdf") then 674 if (isfilevar(infile,"vitu")) then 675 dtvdf = infile->dtvdf 676 else 677 dtvdf = infile->DTV 678 end if 679 myvar = dtvdf*1e7 680 copy_VarMeta(dtvdf,myvar) 681 myvar@units ="K/Vd" 682 myvar@long_name="PBL heating rate" 683 prepared = labelvar 684 end if 685 686 if (labelvar.eq."dTrad") then 687 if (isfilevar(infile,"vitu")) then 688 dtlwr = infile->dtlwr 689 dtswr = infile->dtswr 690 else 691 dtlwr = infile->QRL 692 dtswr = infile->QRS 693 end if 694 myvar = (dtlwr+dtswr)*1e7 695 copy_VarMeta(dtlwr,myvar) 696 myvar@units ="K/Vd" 697 myvar@long_name="Radiative balance" 698 prepared = labelvar 699 end if 700 701 if (labelvar.eq."Tbal") then 702 if (isfilevar(infile,"vitu")) then 703 dtlwr = infile->dtlwr 704 dtswr = infile->dtswr 705 dtajs = infile->dtajs 706 dtdyn = infile->dtdyn 707 dtvdf = infile->dtvdf 708 else 709 dtlwr = infile->QRL 710 dtswr = infile->QRS 711 dtajs = infile->DADJ 712 dtdyn = infile->DTCORE 713 dtvdf = infile->DTV 714 end if 715 myvar = (dtlwr+dtswr+dtajs+dtdyn+dtvdf)*1e7 716 copy_VarMeta(dtlwr,myvar) 717 myvar@units ="K/Vd" 718 myvar@long_name="Thermal balance" 719 prepared = labelvar 720 end if 721 722 if (labelvar.eq."Tforc") then 723 if (isfilevar(infile,"vitu")) then 724 dtlwr = infile->dtlwr 725 dtswr = infile->dtswr 726 dtajs = infile->dtajs 727 if (isfilevar(infile,"dtvdf")) then 728 dtvdf = infile->dtvdf 729 else 730 dtvdf = dtajs*0. 731 end if 732 else 733 dtlwr = infile->QRL 734 dtswr = infile->QRS 735 dtajs = infile->DADJ 736 if (isfilevar(infile,"DTV")) then 737 dtvdf = infile->DTV 738 else 739 dtvdf = dtajs*0. 740 end if 741 end if 742 myvar = (dtlwr+dtswr+dtajs+dtvdf)*1e7 743 copy_VarMeta(dtlwr,myvar) 744 myvar@units ="K/Vd" 745 myvar@long_name="Thermal physical forcing" 746 prepared = labelvar 747 end if 748 749 if (labelvar.eq."ske") then 750 if (isfilevar(infile,"vitu")) then 751 u = infile->vitu 752 v = infile->vitv 753 else 754 u = infile->U 755 v = infile->V 756 end if 757 myvar = u*u+v*v 758 copy_VarMeta(u,myvar) 759 myvar@units ="m2/s2" 760 myvar@long_name="Specific kinetic energy" 761 prepared = labelvar 762 end if 763 764 if (prepared.eq."dummy") then ; DEFAULT: LEAVE AS IS 765 print("You chose a customized variable !") 766 print("Modify the function customVar in visu-utils.ncl to prepare this variable") 767 exit 768 end if 769 770 return(myvar) 771 772 end 773
Note: See TracChangeset
for help on using the changeset viewer.
