*=*=*=*= gcm.html =*=*=*=*
PROGRAM gcm IMPLICIT NONE c ...... Version du 29/04/97 .......... c======================================================================= c c cccccccccccccccccccccccccccccccccccccccccccc c c VERSION MARTIENNE de gcm.F c c sans traceurs c avec sponge c cccccccccccccccccccccccccccccccccccccccccccc c c c Auteur: P. Le Van /L. Fairhead/F.Hourdin c ------- c Modif special traceur F.Forget 05/94 c c Objet: c ------ c c GCM LMD nouvelle grille c c======================================================================= c ... modification de l'integration de q ( 26/04/94 ) .... c .... Valeur moyenne de h , pks et de q aux poles , 8/04/96 ..... c ... Dans inigeom , nouveaux calculs pour les elongations cu , cv c et possibilite d'appeler une fonction f(y) a derivee tangente c hyperbolique a la place de la fonction a derivee sinusoidale. c ... Possibilite de choisir le shema de Van-leer pour l'advection de c q , en faisant iadv = 3 dans traceur (29/04/97) . c c----------------------------------------------------------------------- c Declarations: c ------------- #include "dimensions.h" #include "paramet.h" #include "comconst.h" #include "comdissnew.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" #include "serre.h" #include "sponge.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 ps(ip1jmp1) ! REAL pks(ip1jmp1),pksf(ip1jmp1) ! exner (f pour filtre) REAL phis(ip1jmp1) ! geopotentiel au sol real gdx(ip1jmp1) REAL phi(ip1jmp1,llm) ! geopotentiel REAL w(ip1jmp1,llm) ! vitesse verticale c variables dynamiques intermediaire pour le transport REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm) !flux de masse c variables dynamiques au pas -1 REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm) REAL hm1(ip1jmp1,llm),pextm1(ip1jmp1) 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 c INTEGER iadv(nqmx) ! indice schema de transport pour le traceur iq INTEGER taphistd,taprstar,taphmoy,tapphys INTEGER itau,itaufinp1,iav EXTERNAL caldyn, traceur EXTERNAL dissip,geopot,iniconst,inifilr EXTERNAL integrd,lectba,SCOPY EXTERNAL iniav,writeavs,writedem,writehis EXTERNAL inigeom EXTERNAL exner_new,addit EXTERNAL defrun_new, test_period EXTERNAL vanleer REAL SSUM REAL time_0 , finvpold(ip1jmp1), unsfpnew(ip1jmp1) LOGICAL startdrs,lafin INTEGER ij,l,nnn REAL hppn(iim),hpps(iim),hpn,hps REAL finpe(ip1jmp1) c LOGICAL first c----------------------------------------------------------------------- c Initialisations: c ---------------- startdrs = .TRUE. descript = 'Run GCM LMDZ' lafin = .FALSE. c----------------------------------------------------------------------- c c .... Choix des shemas d'advection pour l'eau et les traceurs ... c ................................................................... c c iadv = 1 shema transport type "humidite specifique LMD" c iadv = 2 shema amont c iadv = 3 shema Van-leer c c dans le tableau q(ij,l,iq) , iq = 1 pour l'eau vapeur c , iq = 2 pour l'eau liquide c et eventuellement , iq = 3, nqmx pour les autres traceurs c c iadv(1): choix pour l'eau vap. et iadv(2) : choix pour l'eau liq. c c iadv( 1 ) = 3 c iadv( 2 ) = 3 c c DO iq = 1, nqmx c IF( iadv(iq).EQ.1 ) PRINT *,' Choix du shema humidite specifique' c * ,' pour le traceur no ', iq c IF( iadv(iq).EQ.2 ) PRINT *,' Choix du shema amont',' pour le' c * ,' traceur no ', iq c IF( iadv(iq).EQ.3 ) PRINT *,' Choix du shema Van-Leer ',' pour' c * ,'le traceur no ', iq c IF( iadv(iq).LE.0.OR.iadv(iq).GT.3 ) THEN c PRINT *,' Erreur dans le choix de iadv . Corriger et repasser c * . ' c STOP c ENDIF c ENDDO c c first = .TRUE. c DO iq = 1, nqmx c IF( iadv(iq).EQ.3.AND.first ) THEN c numvanle = iq c first = .FALSE. c ENDIF c ENDDO c c DO iq = 1, nqmx c IF( iadv(iq).NE.3.AND.iq.GT.numvanle ) THEN c PRINT *,' Il y a discontinuite dans le choix du shema de ', c * 'Van-leer pour les traceurs . Corriger et repasser . ' c STOP c ENDIF c IF( iadv(iq).LT.1.OR.iadv(iq).GT.3 ) THEN c PRINT *,' Le choix de iadv est errone pour le traceur ', c * iq c STOP c ENDIF c ENDDO c c----------------------------------------------------------------------- CALL lectba(startdrs,nqmx,vcov,ucov,h,q,pext,phis,time_0) CALL defrun_new( .FALSE. ) print *,'iperiod iphysiq ',iperiod,iphysiq c on recalcule eventuellement le pas de temps IF(MOD(day_step,iperiod).NE.0) * STOP'Il faut choisir un nb de pas par jour multiple de iperiod' IF(MOD(day_step,iphysiq).NE.0) * STOP'Il faut choisir un nb de pas par jour multiple de iphysiq' 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 CALL inifilr c ...... P.Le Van ( modif le 29/04/97 ) ......... c CALL inidissip( lstardis, nitergdiv, nitergrot, niterh , * tetagdiv, tetagrot , tetatemp ) c CALL exner_new( ip1jmp1, pext, .TRUE., 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 c IF( MOD( itau, 10* day_step ).EQ.0 ) THEN CALL test_period ( ucov,vcov,h,q,pext,phis ) PRINT *,' ---- Test_period OK ! -----', itau ENDIF call groupeun(jjp1,llm,ucov,.true.) call groupeun(jjm,llm,vcov,.true.) call groupeun(jjp1,llm,h,.true.) call groupeun(jjp1,1,pext,.false.) CALL SCOPY( ijmllm ,vcov, 1, vcovm1 , 1 ) CALL SCOPY( ijp1llm,ucov, 1, ucovm1 , 1 ) CALL SCOPY( ijp1llm, h, 1, hm1 , 1 ) CALL SCOPY( ip1jmp1,pext, 1, pextm1, 1 ) cc z.x.li CALL SCOPY( ijp1llm*nqmx,q,1,qm1,1 ) forward = .TRUE. leapf = .FALSE. dt = dtvr c ... P.Le Van .26/04/94 .... CALL SCOPY ( ip1jmp1, pext, 1, finvpold, 1 ) CALL filtreg ( finvpold ,jjp1, 1, -2,2, .TRUE., 1 ) 2 CONTINUE c----------------------------------------------------------------------- c date: c ----- c gestion des appels de la physique et des dissipations: c ------------------------------------------------------ c c ... P.Le Van ( 6/02/95 ) .... 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..NOT.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+1,iphysiq).EQ.0. AND. physic ) apphys = .TRUE. END IF c----------------------------------------------------------------------- c calcul des tendances dynamiques: c -------------------------------- CALL geopot (ip1jmp1, h , pks , phis , phi ) c IF (conser) print*,'*********** jour julien = ',iday c CALL caldyn $ (itau,ucov,vcov,h,pext,pks,pksf,phis, $ phi,conser,du,dv,dh,dp,w, pbaru,pbarv, $ time+iday-day_ini) c----------------------------------------------------------------------- c calcul des tendances advection des traceurs (dont l'humidite) c ------------------------------------------------------------- c c IF( forward. OR . leapf ) THEN c c iapp_tracvl = 5 c CALL SCOPY ( ip1jmp1, pext, 1, finpe, 1 ) c CALL filtreg ( finpe ,jjp1, 1, -2,2, .TRUE., 1 ) c CALL tracvl( 1,iapp_tracvl,nqmx,pbaru,pbarv,finpe,q) c c ENDIF c c----------------------------------------------------------------------- c integrations dynamique et traceurs: c ---------------------------------- CALL integrd ( 2,vcovm1,ucovm1,hm1,pextm1 , $ dv,du,dh,dq,dp,vcov,ucov,h,q,pext,phis,finvpold,unsfpnew ) c .P.Le Van (26/04/94 ajout de finvpold dans l'appel d'integrd) c c----------------------------------------------------------------------- c calcul des tendances physiques: c ------------------------------- c ######## P.Le Van ( Modif le 6/02/95 ) ########### c IF( purmats ) THEN IF( itau.EQ.itaufin.AND..NOT.forward ) lafin = .TRUE. ELSE IF( itau+1. EQ. itaufin ) lafin = .TRUE. ENDIF c c IF( apphys ) THEN print*,'APPEL de la PHYSIQUE' c c ....... Ajout P.Le Van ( 17/04/96 ) ........... c CALL exner_new( ip1jmp1, pext, .FALSE., pks, pksf ) CALL calfis( nqmx, lafin ,iday,time , $ ucov,vcov,h,q,pext,pks,phis,phi , $ du,dv,dh,dq,w,dufi,dvfi,dhfi,dqfi,dpfi,unsfpnew ) c ajout des tendances physiques: c ------------------------------ CALL addfi( nqmx,dtphys, leapf, forward , $ ucov, vcov, h , q ,pext , $ dufi, dvfi, dhfi , dqfi ,dpfi ) c ENDIF CALL exner_new( ip1jmp1, pext, .TRUE., pks, pksf ) c----------------------------------------------------------------------- c c c dissipation horizontale et verticale des petites echelles: c ---------------------------------------------------------- IF(apdiss) THEN IF(callsponge) THEN CALL sponge(ucov,vcov,h,pext,dtdiss,mode_sponge) ENDIF 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 ) c ....... P. Le Van ( ajout le 17/04/96 ) ........... c ... Calcul de la valeur moyenne, unique de h aux poles ..... c IF( alphax.NE. 0. ) THEN DO l = 1, llm DO ij = 1,iim hppn(ij) = aire( ij ) * h( ij ,l) hpps(ij) = aire(ij+ip1jm) * h(ij+ip1jm,l) ENDDO hpn = SSUM(iim,hppn,1)/apoln hps = SSUM(iim,hpps,1)/apols DO ij = 1, iip1 h( ij ,l) = hpn h(ij+ip1jm,l) = hps ENDDO ENDDO ENDIF 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 writeavs( 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 c c ......... P. Le Van ( modif le 19/04/96 ) ........... c CALL geopot(ip1jmp1,h,pks,phis,phi) CALL writehis(taphistd,nqmx,startdrs,time+iday-day_ini, . vcov,ucov,h,phi,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) c ecriture binaire de l'etat final pour test 1+1=2 c OPEN(99,file='champ_fin',form='unformatted', c . status='unknown') c WRITE(99) ucov,vcov,h,pext,phis c 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 c ########## P. Le Van ( ajout 19/12/95 ) ############ c IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN IF(itau.EQ.itaufin) THEN iav=1 ELSE iav=0 ENDIF CALL writeavs( nqmx,dtav,time+iday-day_ini , . ucov,vcov,h,q,pext,iav ) ENDIF IF(MOD(itau,iecri*day_step).EQ.0) THEN nbetat = nbetatdem c c ......... P. Le Van ( modif le 19/04/96 ) ........... c CALL geopot(ip1jmp1,h,pks,phis,phi) CALL writehis(taphistd,nqmx,startdrs,time+iday-day_ini, . vcov,ucov,h,phi,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'i7,3x'au jour'i7//) STOP END