*=*=*=*= gcm.html =*=*=*=*
PROGRAM gcm IMPLICIT NONE c======================================================================= c c Auteur: P. Le Van c ------- c c Objet: c ------ c c GCM LMD nouvelle grille c c======================================================================= c----------------------------------------------------------------------- c Declarations: c ------------- #include "dimensions.h" #include "paramet.h" INTEGER nqmx PARAMETER(nqmx=1) #include "comconst.h" #include "comdissip.h" #include "comvert.h" #include "comgeom.h" #include "logic.h" #include "temps.h" #include "control.h" #include "ener.h" #include "drsdef.h" #include "description.h" INTEGER*4 iday ! jour julien REAL time ! Heure de la journee en fraction d'1 jour REAL zdtvr INTEGER nbetatmoy, nbetatdem,nbetat INTEGER ierr, aslun, cllun c variables dynamiques REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants REAL h(ip1jmp1,llm) ! temperature potentielle REAL q(ip1jmp1,llm,nqmx) ! champs advectes REAL pext(ip1jmp1) ! pression extensive REAL pks(ip1jmp1),pksf(ip1jmp1) ! exner (f pour filtre) REAL phis(ip1jmp1) ! geopotentiel au sol REAL phi(ip1jmp1,llm) ! geopotentiel REAL w(ip1jmp1,llm) ! vitesse verticale c variables dynamiques au pas -1 REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm) REAL hm1(ip1jmp1,llm),pextm1(ip1jmp1) c z.x.li REAL qm1(ip1jmp1,llm,nqmx) c tendances dynamiques REAL dv(ip1jm,llm),du(ip1jmp1,llm) REAL dh(ip1jmp1,llm),dq(ip1jmp1,llm,nqmx),dp(ip1jmp1) c tendances de la dissipation REAL dvdis(ip1jm,llm),dudis(ip1jmp1,llm) REAL dhdis(ip1jmp1,llm) c tendances physiques REAL dvfi(ip1jm,llm),dufi(ip1jmp1,llm) REAL dhfi(ip1jmp1,llm),dqfi(ip1jmp1,llm,nqmx),dpfi(ip1jmp1) c variables pour le fichier histoire REAL dtav ! intervalle de temps elementaire INTEGER taphistd,taprstar,taphmoy,tapphys INTEGER itau,itaufinp1,iav EXTERNAL caldyn EXTERNAL dissip,geopot,iniconst,inifilr,ecriba EXTERNAL integrd,lectba,SCOPY EXTERNAL iniav,writeav EXTERNAL inigeom EXTERNAL exner,addit REAL time_0 LOGICAL startdrs c----------------------------------------------------------------------- c Initialisations: c ---------------- c quelques constantes pour la dissipation tetavel=30000. tetatemp=30000. niterdis=2 lstardis=.false. grireg=.true. startdrs=.true. descript='Test DRS sur testdyn' c----------------------------------------------------------------------- CALL lectba(startdrs,nqmx,vcov,ucov,h,q,pext,phis,time_0) CALL defrun(5) c on recalcule eventuellement le pas de temps IF(MOD(day_step,iperiod).NE.0) sSTOP'Il faut choisir un nb de pas par jour multiple de iperiod' zdtvr = daysec/float(day_step) IF(dtvr.NE.zdtvr) THEN PRINT*,'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr ENDIF c nombre d'etats dans les fichiers demarrage et histoire nbetatdem = nday / iecri nbetatmoy = nday / periodav + 1 dtvr=zdtvr CALL iniconst CALL inigeom IF(grireg) CALL inifilr CALL inidissip(lstardis,niterdis,tetavel,tetatemp) CALL exner(ip1jmp1,pext,aire,pks,pksf) c numero de stockage pour les fichiers de redemarrage: taphistd=10 tapphys=12 taprstar=15 taphmoy=20 c ouverture DRS des fichiers de stockage IF(startdrs) THEN ierr = aslun(taphistd,'histoire.dic', . taphistd+1,'histoire.dat',IDRS_CREATE) ELSE PRINT*,'Ouverture binaire',taphistd OPEN(taphistd,file='histoire',form='unformatted', . status='new',iostat=ierr) ENDIF if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier histoire (rdem)' write(6,*)' ierr = ', ierr call exit(1) endif IF(startdrs) THEN ierr = aslun(taprstar,'restart.dic', . taprstar+1,'restart.dat',IDRS_CREATE) ELSE OPEN(taprstar,file='restart',form='unformatted', . status='new',iostat=ierr) ENDIF if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier restart' write(6,*)' ierr = ', ierr call exit(1) endif ierr = aslun(taphmoy,'histmoy.dic', . taphmoy+1,'histmoy.dat',IDRS_CREATE) if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier restart' write(6,*)' ierr = ', ierr call exit(1) endif ierr = aslun(tapphys,'histphy.dic', . tapphys+1,'histphy.dat',IDRS_CREATE) if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier physique' write(6,*)' ierr = ', ierr call exit(1) endif c----------------------------------------------------------------------- c temps de depart et de fin: c -------------------------- itau=0 iday=day_ini+itau/day_step time=FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0 IF(time.GT.1.) THEN time=time-1. iday=iday+1 ENDIF itaufin = nday*day_step itaufinp1 = itaufin +1 day_end=day_ini+nday PRINT 300, itau,itaufin,day_ini,day_end CALL iniwrite(taphistd,startdrs,day_ini,phis) CALL iniwrite(tapphys,startdrs,day_ini,phis) CALL iniwrite(taprstar,startdrs,day_end,phis) ecripar = .true. dtav=iperiod*dtvr/daysec CALL iniav(taphmoy,day_ini,0.,periodav,phis) c----------------------------------------------------------------------- c Debut de l'integration temporelle: c ---------------------------------- 1 CONTINUE CALL SCOPY( ijmllm,vcov,1,vcovm1,1 ) CALL SCOPY( ijp1llm,ucov,1,ucovm1,1 ) CALL SCOPY( ijp1llm,h,1,hm1,1 ) c z.x.li CALL SCOPY( ijp1llm*nqmx,q,1,qm1,1 ) CALL SCOPY( ip1jmp1,pext,1,pextm1,1 ) forward = .true. leapf = .false. dt = dtvr 2 CONTINUE c----------------------------------------------------------------------- c date: c ----- c gestion des appels de la physique et des dissipations: c ------------------------------------------------------ apphys = .false. statcl = .false. conser = .false. apdiss = .false. IF( purmats ) THEN IF( MOD(itau,iconser) .eq.0.AND. forward ) conser = .true. IF( MOD(itau,idissip ).eq.0.AND..NOT.forward ) apdiss = .true. IF( MOD(itau,iphysiq ).eq.0.AND. forward $ .AND. physic ) apphys = .true. ELSE IF( MOD(itau ,iconser) .eq. 0 ) conser = .true. IF( MOD(itau+1,idissip) .eq. 0 ) apdiss = .true. IF( MOD(itau,iphysiq).eq.0.AND.forward $ .AND. physic ) apphys = .true. END IF c----------------------------------------------------------------------- c calcul des tendances dynamiques: c -------------------------------- CALL geopot (ip1jmp1, h , pks , phis , phi ) CALL caldyn $ (nqmx,itau,ucov,vcov,h,q,pext,pks,pksf,phis, $ phi,conser,du,dv,dh,dp,dq,w, $ time+iday-day_ini) c----------------------------------------------------------------------- c calcul des tendances physiques: c ------------------------------- IF(apphys) CALL calfis(nqmx,itau.EQ.0,itau+iphysiq.EQ.itaufin, $ iday,0., $ ucov,vcov,h,q,pext,pks,phis,phi, $ du,dv,dh,dq,w, $ dufi,dvfi,dhfi,dqfi,dpfi) c======================================================================= c c----------------------------------------------------------------------- c integrations dynamique: c ----------------------- CALL integrd $ ( nqmx,vcovm1,ucovm1,hm1,pextm1, c z.x.li $ ( nqmx,vcovm1,ucovm1,hm1,qm1,pextm1, $ dv,du,dh,dq,dp, $ vcov,ucov,h,q,pext,phis ) c----------------------------------------------------------------------- c ajout des tendances physiques: c ------------------------------ c Ajout des tendances a chaque pas d'integration .... IF(physic) CALL addfi( nqmx,dt, leapf, forward, s ucov, vcov, h , q ,pext, s dufi, dvfi, dhfi , dqfi ,dpfi) CALL exner(ip1jmp1,pext,aire,pks,pksf) c----------------------------------------------------------------------- c dissipation horizontal et verticales des petites echelles: c ---------------------------------------------------------- IF(apdiss) THEN CALL dissip(vcov,ucov,h,dvdis,dudis,dhdis) CALL addit(ijp1llm,ucov,dudis,ucov) CALL addit(ijmllm,vcov,dvdis,vcov) CALL addit(ijp1llm,h,dhdis,h) END IF c ******************************************************************** c ******************************************************************** c .... fin de l'integration dynamique et physique pour le pas itau .. c ******************************************************************** c ******************************************************************** c preparation du pas d'integration suivant ...... IF ( .not.purmats ) THEN c ........................................................ c .............. schema matsuno + leapfrog .............. c ........................................................ IF(forward. OR. leapf) THEN itau= itau + 1 iday=day_ini+itau/day_step time=FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0 IF(time.GT.1.) THEN time=time-1. iday=iday+1 ENDIF ENDIF IF( itau. eq. itaufinp1 ) STOP c----------------------------------------------------------------------- c ecriture du fichier histoire moyenne: c ------------------------------------- IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN IF(itau.EQ.itaufin) THEN iav=1 ELSE iav=0 ENDIF CALL writeav(nqmx,dtav,time+iday-day_ini . ,ucov,vcov,h,q,pext,iav) ENDIF c----------------------------------------------------------------------- c ecriture de la bande histoire: c ------------------------------ IF( MOD(itau,iecri*day_step).eq.0) THEN nbetat = nbetatdem call writedem(taphistd,nqmx,startdrs,time+iday-day_ini, . vcov,ucov,h,q,pext, . phis,nbetat) ENDIF IF(itau.EQ.itaufin) THEN call writedem(taprstar,nqmx,startdrs,0.,vcov,ucov,h,q, . pext,phis, 1) CLOSE(99) OPEN(99,file='champ_fin',form='unformatted',status='new') WRITE(99) ucov,vcov,h,pext,phis CLOSE(99) ENDIF c----------------------------------------------------------------------- c gestion de l'integration temporelle: c ------------------------------------ IF( MOD(itau,iperiod).eq.0 ) THEN GO TO 1 ELSE IF ( MOD(itau-1,iperiod). eq. 0 ) THEN IF( forward ) THEN c fin du pas forward et debut du pas backward forward = .false. leapf = .false. GO TO 2 ELSE c fin du pas backward et debut du premier pas leapfrog leapf = .true. dt = 2.*dtvr GO TO 2 END IF ELSE c ...... pas leapfrog ..... leapf = .true. dt = 2.*dtvr GO TO 2 END IF ELSE c ........................................................ c .............. schema matsuno ............... c ........................................................ IF( forward ) THEN itau= itau + 1 iday=day_ini+itau/day_step time=FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0 IF(time.GT.1.) THEN time=time-1. iday=iday+1 ENDIF forward = .false. IF( itau. eq. itaufinp1 ) STOP GO TO 2 ELSE IF(MOD(itau,iecri*day_step).EQ.0) THEN nbetat = nbetatdem call writedem(taphistd,nqmx,startdrs, . time+iday-day_ini, . vcov,ucov,h,q,pext, . phis,nbetat) ENDIF IF(itau.EQ.itaufin) . call writedem(taprstar,nqmx,startdrs,0.,vcov,ucov,h,q . ,pext,phis,1) forward = .true. GO TO 1 ENDIF END IF ierr = cllun(taphistd) ierr = cllun(taprstar) ierr = cllun(taphmoy) 300 FORMAT('1'/15x'run du pas'i7,2x,'au pas'i7,2x, 'c"est a dire du * jour'f5.0,3x'au jour'f5.0//) STOP END