Changeset 841 for trunk/LMDZ.COMMON/libf/dyn3dpar
- Timestamp:
- Nov 13, 2012, 9:21:32 AM (12 years ago)
- Location:
- trunk/LMDZ.COMMON/libf/dyn3dpar
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.COMMON/libf/dyn3dpar/calfis_p.F
r776 r841 244 244 integer :: k,kstart,kend 245 245 INTEGER :: offset 246 247 LOGICAL tracerdyn ! for generic/mars physics call ; possibly to get rid of 246 248 c 247 249 c----------------------------------------------------------------------- … … 701 703 . pducov, 702 704 . PVteta) 705 706 else if ( planet_type=="generic" ) then 707 708 CALL physiq (klon, !! ngrid 709 . llm, !! nlayer 710 . nqtot, !! nq 711 . tname, !! tracer names from dynamical core (given in infotrac) 712 . debut_split, !! firstcall 713 . lafin_split, !! lastcall 714 . jD_cur, !! pday. see leapfrog_p 715 . jH_cur_split, !! ptime "fraction of day" 716 . zdt_split, !! ptimestep 717 . zplev_omp, !! pplev 718 . zplay_omp, !! pplay 719 . zphi_omp, !! pphi 720 . zufi_omp, !! pu 721 . zvfi_omp, !! pv 722 . ztfi_omp, !! pt 723 . zqfi_omp, !! pq 724 . flxwfi_omp, !! pw !! or 0. anyway this is for diagnostic. not used in physiq. 725 . zdufi_omp, !! pdu 726 . zdvfi_omp, !! pdv 727 . zdtfi_omp, !! pdt 728 . zdqfi_omp, !! pdq 729 . zdpsrf_omp, !! pdpsrf 730 . tracerdyn) !! tracerdyn <-- utilite ??? 731 703 732 else ! a moduler pour Mars 704 733 CALL physiq (klon, -
trunk/LMDZ.COMMON/libf/dyn3dpar/comconst.h
r108 r841 21 21 REAL dtdiss ! (s) time step for the dissipation 22 22 REAL rad ! (m) radius of the planet 23 REAL r ! Gas constant R=8.31 J.K-1.mol-1 23 REAL r ! Reduced Gas constant r=R/mu 24 ! with R=8.31.. J.K-1.mol-1, mu: mol mass of atmosphere (kg/mol) 24 25 REAL cpp ! Cp 25 26 REAL kappa ! kappa=R/Cp -
trunk/LMDZ.COMMON/libf/dyn3dpar/comvert.h
r776 r841 1 1 ! 2 ! $Id: comvert.h 16 25 2012-05-09 13:14:48Z lguez$2 ! $Id: comvert.h 1654 2012-09-24 15:07:18Z aslmd $ 3 3 ! 4 4 !----------------------------------------------------------------------- … … 7 7 COMMON/comvertr/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm), & 8 8 & pa,preff,nivsigs(llm),nivsig(llm+1), & 9 & aps(llm),bps(llm),scaleheight 9 & aps(llm),bps(llm),scaleheight,pseudoalt(llm) 10 10 11 11 common/comverti/disvert_type, pressure_exner … … 23 23 real bps ! hybrid sigma contribution at mid-layers 24 24 real scaleheight ! atmospheric (reference) scale height (km) 25 real pseudoalt ! for planets 25 26 26 27 integer disvert_type ! type of vertical discretization: -
trunk/LMDZ.COMMON/libf/dyn3dpar/disvert_noterre.F
r124 r841 1 ! $Id: $ 1 2 SUBROUTINE disvert_noterre 2 3 … … 22 23 c 23 24 c======================================================================= 24 c Discretisation verticale en coordonnée hybride 25 c Discretisation verticale en coordonnée hybride (ou sigma) 25 26 c 26 27 c======================================================================= … … 45 46 real tt,rr,gg, prevz 46 47 real s(llm),dsig(llm) 47 real pseudoalt(llm)48 48 49 49 integer iz 50 50 real z, ps,p 51 character(len=*),parameter :: modname="disvert_noterre" 51 52 52 53 c … … 54 55 c 55 56 ! Initializations: 56 pi=2.*ASIN(1.) 57 ! pi=2.*ASIN(1.) ! already done in iniconst 57 58 58 59 hybrid=.true. ! default value for hybrid (ie: use hybrid coordinates) 59 60 CALL getin('hybrid',hybrid) 60 write(lunout,*) 'disvert_noterre: hybrid=',hybrid61 write(lunout,*) trim(modname),': hybrid=',hybrid 61 62 62 63 ! Ouverture possible de fichiers typiquement E.T. … … 156 157 157 158 DO l=1,llm 158 nivsigs(l) = FLOAT(l)159 nivsigs(l) = REAL(l) 159 160 ENDDO 160 161 161 162 DO l=1,llmp1 162 nivsig(l)= FLOAT(l)163 nivsig(l)= REAL(l) 163 164 ENDDO 164 165 … … 199 200 bp(llmp1) = 0. 200 201 201 write(lunout,*) 'BP '202 write(lunout,*) trim(modname),': BP ' 202 203 write(lunout,*) bp 203 write(lunout,*) 'AP '204 write(lunout,*) trim(modname),': AP ' 204 205 write(lunout,*) ap 205 206 … … 225 226 end if 226 227 227 write(lunout,*) 'BPs '228 write(lunout,*) trim(modname),': BPs ' 228 229 write(lunout,*) bps 229 write(lunout,*) 'APs'230 write(lunout,*) trim(modname),': APs' 230 231 write(lunout,*) aps 231 232 … … 235 236 ENDDO 236 237 237 write(lunout,*) 'PRESNIVS'238 write(lunout,*)trim(modname),' : PRESNIVS' 238 239 write(lunout,*)presnivs 239 240 write(lunout,*)'Pseudo altitude of Presnivs : (for a scale ', -
trunk/LMDZ.COMMON/libf/dyn3dpar/dynetat0.F
r776 r841 7 7 USE infotrac 8 8 use netcdf, only: nf90_get_var 9 10 use control_mod, only : planet_type 11 9 12 IMPLICIT NONE 10 13 … … 54 57 INTEGER ierr, nid, nvarid 55 58 59 INTEGER idecal 60 56 61 c----------------------------------------------------------------------- 57 62 … … 77 82 ENDIF 78 83 84 !!! AS: idecal is a hack to be able to read planeto starts... 85 !!! .... while keeping everything OK for LMDZ EARTH 86 if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then 87 write(lunout,*)'dynetat0 : Planeto-like start file' 88 idecal = 4 89 annee_ref = 2000 90 else 91 write(lunout,*)'dynetat0 : Earth-like start file' 92 idecal = 5 93 annee_ref = tab_cntrl(5) 94 endif 95 96 79 97 im = tab_cntrl(1) 80 98 jm = tab_cntrl(2) 81 99 lllm = tab_cntrl(3) 82 100 day_ref = tab_cntrl(4) 83 annee_ref = tab_cntrl(5) 84 rad = tab_cntrl(6) 85 omeg = tab_cntrl(7) 86 g = tab_cntrl(8) 87 cpp = tab_cntrl(9) 88 kappa = tab_cntrl(10) 89 daysec = tab_cntrl(11) 90 dtvr = tab_cntrl(12) 91 etot0 = tab_cntrl(13) 92 ptot0 = tab_cntrl(14) 93 ztot0 = tab_cntrl(15) 94 stot0 = tab_cntrl(16) 95 ang0 = tab_cntrl(17) 96 pa = tab_cntrl(18) 97 preff = tab_cntrl(19) 98 c 99 clon = tab_cntrl(20) 100 clat = tab_cntrl(21) 101 grossismx = tab_cntrl(22) 102 grossismy = tab_cntrl(23) 103 c 104 IF ( tab_cntrl(24).EQ.1. ) THEN 101 rad = tab_cntrl(idecal+1) 102 omeg = tab_cntrl(idecal+2) 103 g = tab_cntrl(idecal+3) 104 cpp = tab_cntrl(idecal+4) 105 kappa = tab_cntrl(idecal+5) 106 daysec = tab_cntrl(idecal+6) 107 dtvr = tab_cntrl(idecal+7) 108 etot0 = tab_cntrl(idecal+8) 109 ptot0 = tab_cntrl(idecal+9) 110 ztot0 = tab_cntrl(idecal+10) 111 stot0 = tab_cntrl(idecal+11) 112 ang0 = tab_cntrl(idecal+12) 113 pa = tab_cntrl(idecal+13) 114 preff = tab_cntrl(idecal+14) 115 c 116 clon = tab_cntrl(idecal+15) 117 clat = tab_cntrl(idecal+16) 118 grossismx = tab_cntrl(idecal+17) 119 grossismy = tab_cntrl(idecal+18) 120 c 121 IF ( tab_cntrl(idecal+19).EQ.1. ) THEN 105 122 fxyhypb = . TRUE . 106 123 c dzoomx = tab_cntrl(25) … … 111 128 fxyhypb = . FALSE . 112 129 ysinus = . FALSE . 113 IF( tab_cntrl( 27).EQ.1. ) ysinus = . TRUE.130 IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE. 114 131 ENDIF 115 132 … … 225 242 IF (ierr .NE. NF_NOERR) THEN 226 243 write(lunout,*)"dynetat0: Le champ <temps> est absent" 227 CALL abort 244 write(lunout,*)"dynetat0: J essaie <Time>" 245 ierr = NF_INQ_VARID (nid, "Time", nvarid) 246 IF (ierr .NE. NF_NOERR) THEN 247 write(lunout,*)"dynetat0: Le champ <Time> est absent" 248 CALL abort 249 ENDIF 228 250 ENDIF 229 251 ierr = nf90_get_var(nid, nvarid, time) -
trunk/LMDZ.COMMON/libf/dyn3dpar/fxhyp.F
r1 r841 1 1 ! 2 ! $Id: fxhyp.F 1 403 2010-07-01 09:02:53Z fairhead$2 ! $Id: fxhyp.F 1674 2012-10-29 16:27:03Z emillour $ 3 3 ! 4 4 c … … 48 48 c 49 49 REAL dzoom 50 REAL *8xlon(iip1),xprimm(iip1),xuv51 REAL *8xtild(0:nmax2)52 REAL *8fhyp(0:nmax2),ffdx,beta,Xprimt(0:nmax2)53 REAL *8Xf(0:nmax2),xxpr(0:nmax2)54 REAL *8xvrai(iip1),xxprim(iip1)55 REAL *8pi,depi,epsilon,xzoom,fa,fb56 REAL *8Xf1, Xfi , a0,a1,a2,a3,xi250 REAL(KIND=8) xlon(iip1),xprimm(iip1),xuv 51 REAL(KIND=8) xtild(0:nmax2) 52 REAL(KIND=8) fhyp(0:nmax2),ffdx,beta,Xprimt(0:nmax2) 53 REAL(KIND=8) Xf(0:nmax2),xxpr(0:nmax2) 54 REAL(KIND=8) xvrai(iip1),xxprim(iip1) 55 REAL(KIND=8) pi,depi,epsilon,xzoom,fa,fb 56 REAL(KIND=8) Xf1, Xfi , a0,a1,a2,a3,xi2 57 57 INTEGER i,it,ik,iter,ii,idif,ii1,ii2 58 REAL *8xi,xo1,xmoy,xlon2,fxm,Xprimin59 REAL *8champmin,champmax,decalx58 REAL(KIND=8) xi,xo1,xmoy,xlon2,fxm,Xprimin 59 REAL(KIND=8) champmin,champmax,decalx 60 60 INTEGER is2 61 61 SAVE is2 62 62 63 REAL *8heavyside63 REAL(KIND=8) heavyside 64 64 65 65 pi = 2. * ASIN(1.) … … 68 68 xzoom = xzoomdeg * pi/180. 69 69 c 70 if (iim==1) then 71 72 rlonm025(1)=-pi/2. 73 rlonv(1)=0. 74 rlonu(1)=pi 75 rlonp025(1)=pi/2. 76 rlonm025(2)=rlonm025(1)+depi 77 rlonv(2)=rlonv(1)+depi 78 rlonu(2)=rlonu(1)+depi 79 rlonp025(2)=rlonp025(1)+depi 80 81 xprimm025(:)=1. 82 xprimv(:)=1. 83 xprimu(:)=1. 84 xprimp025(:)=1. 85 champmin=depi 86 champmax=depi 87 return 88 89 endif 90 70 91 decalx = .75 71 92 IF( grossism.EQ.1..AND.scal180 ) THEN … … 286 307 287 308 309 288 310 IF(ik.EQ.1.and.grossism.EQ.1.) THEN 289 311 xvrai(1) = xvrai(iip1)-depi 290 312 xxprim(1) = xxprim(iip1) 291 313 ENDIF 314 292 315 DO i = 1 , iim 293 316 xlon(i) = xvrai(i) -
trunk/LMDZ.COMMON/libf/dyn3dpar/gcm.F
r815 r841 449 449 c ------------------------------- 450 450 451 IF (call_iniphys.and.(iflag_phys .eq.1)) THEN451 IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100)) THEN 452 452 latfi(1)=rlatu(1) 453 453 lonfi(1)=0. … … 469 469 ! Physics 470 470 #ifdef CPP_PHYS 471 CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys , 472 , latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp ) 473 #endif ! CPP_PHYS 471 CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys, 472 & latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp, 473 & iflag_phys) 474 #endif 474 475 call_iniphys=.false. 475 ENDIF ! of IF (call_iniphys.and.(iflag_phys .eq.1))476 ENDIF ! of IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100)) 476 477 477 478 … … 513 514 #endif 514 515 515 #ifdef CPP_PHYS516 ! Create start file (startphy.nc) and boundary conditions (limit.nc)517 ! for the Earth verstion518 if (iflag_phys>=100) then519 call iniaqua(ngridmx,latfi,lonfi,iflag_phys)520 endif521 #endif522 523 516 if (planet_type.eq."mars") then 524 517 ! POUR MARS, METTRE UNE FONCTION A PART, genre dynredem0_mars -
trunk/LMDZ.COMMON/libf/dyn3dpar/groupe_p.F
r1 r841 37 37 integer i,j,l 38 38 39 logical firstcall 40 save firstcall 41 c$OMP THREADPRIVATE(firstcall )39 logical firstcall,groupe_ok 40 save firstcall,groupe_ok 41 c$OMP THREADPRIVATE(firstcall,groupe_ok) 42 42 43 43 data firstcall/.true./ 44 data groupe_ok/.true./ 45 44 46 integer ijb,ije,jjb,jje 45 47 48 if (iim==1) then 49 groupe_ok=.false. 50 endif 51 46 52 if (firstcall) then 47 if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre ede point' 53 if (groupe_ok) then 54 if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre de point' 55 endif 48 56 firstcall=.false. 49 57 endif … … 66 74 c$OMP END DO NOWAIT 67 75 68 call groupeun_p(jjp1,llm,jjb,jje,zconvmm) 76 if (groupe_ok) then 77 call groupeun_p(jjp1,llm,jjb,jje,zconvmm) 78 endif 69 79 70 80 jjb=jj_begin-1 … … 78 88 c$OMP END DO NOWAIT 79 89 80 call groupeun_p(jjm,llm,jjb,jje,pbarvm) 90 if (groupe_ok) then 91 call groupeun_p(jjm,llm,jjb,jje,pbarvm) 92 endif 81 93 82 94 c Champs 3D … … 101 113 enddo 102 114 c$OMP END DO NOWAIT 115 103 116 c integration de la convergence de masse de haut en bas ...... 104 117 -
trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F
r776 r841 147 147 REAL :: secondes 148 148 real :: rdaym_ini 149 149 logical :: physic 150 150 LOGICAL first,callinigrads 151 151 … … 231 231 232 232 itau = 0 233 physic=.true. 234 if (iflag_phys==0.or.iflag_phys==2) physic=.false. 233 235 ! iday = day_ini+itau/day_step 234 236 ! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 … … 404 406 s apdiss = .TRUE. 405 407 IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward 406 s .and. iflag_phys.EQ.1) apphys = .TRUE.408 s .and. physic ) apphys = .TRUE. 407 409 ELSE 408 410 ! Leapfrog/Matsuno time stepping … … 410 412 IF( MOD(itau+1,dissip_period).EQ.0 .AND. .NOT. forward ) 411 413 s apdiss = .TRUE. 412 IF( MOD(itau+1,iphysiq).EQ.0.AND. iflag_phys.EQ.1) apphys=.TRUE.414 IF( MOD(itau+1,iphysiq).EQ.0.AND.physic) apphys=.TRUE. 413 415 END IF 414 416 … … 539 541 endif 540 542 c$OMP END MASTER 541 endif 543 endif ! of if (Adjust) 542 544 543 545 … … 546 548 c calcul des tendances dynamiques: 547 549 c -------------------------------- 550 ! ADAPTATION GCM POUR CP(T) 551 call tpot2t_p(ip1jmp1,llm,teta,temp,pk) 552 ijb=ij_begin 553 ije=ij_end 554 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 555 do l=1,llm 556 tsurpk(ijb:ije,l)=cpp*temp(ijb:ije,l)/pk(ijb:ije,l) 557 enddo 558 !$OMP END DO 559 560 if (debug) then 561 !$OMP BARRIER 562 !$OMP MASTER 563 call WriteField_p('temp',reshape(temp,(/iip1,jmp1,llm/))) 564 call WriteField_p('tsurpk',reshape(tsurpk,(/iip1,jmp1,llm/))) 565 !$OMP END MASTER 566 !$OMP BARRIER 567 endif ! of if (debug) 568 548 569 c$OMP BARRIER 549 570 c$OMP MASTER … … 600 621 True_itau=True_itau+1 601 622 602 ! ADAPTATION GCM POUR CP(T)603 call tpot2t_p(ip1jmp1,llm,teta,temp,pk)604 ijb=ij_begin605 ije=ij_end606 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)607 do l=1,llm608 tsurpk(ijb:ije,l)=cpp*temp(ijb:ije,l)/pk(ijb:ije,l)609 enddo610 !$OMP END DO611 612 623 c$OMP MASTER 613 624 IF (prt_level>9) THEN … … 784 795 jD_cur = jD_ref + day_ini - day_ref 785 796 $ + itau/day_step 797 798 IF (planet_type .eq."generic") THEN 799 ! AS: we make jD_cur to be pday 800 jD_cur = int(day_ini + itau/day_step) 801 ENDIF 802 786 803 jH_cur = jH_ref + start_time + & 787 804 & mod(itau,day_step)/float(day_step) -
trunk/LMDZ.COMMON/libf/dyn3dpar/parallel.F90
r492 r841 489 489 enddo 490 490 491 endif 491 else 492 ! Ehouarn: When in debug mode, ifort complains (for call MPI_GATHERV 493 ! below) about Buffer_Recv() being not allocated. 494 ! So make a dummy allocation. 495 allocate(Buffer_Recv(1)) 496 endif ! of if (MPI_Rank==rank) 492 497 493 498 !$OMP CRITICAL (MPI) -
trunk/LMDZ.COMMON/libf/dyn3dpar/paramet.h
r1 r841 17 17 INTEGER jcfil,jcfllm 18 18 19 PARAMETER( iip1= iim+1 -1/iim,iip2=iim+2,iip3=iim+3&19 PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3 & 20 20 & ,jjp1=jjm+1-1/jjm) 21 21 PARAMETER( llmp1 = llm+1, llmp2 = llm+2, llmm1 = llm-1 )
Note: See TracChangeset
for help on using the changeset viewer.