*=*=*=*= defrun_new.html =*=*=*=*
SUBROUTINE defrun_new( etatinit ) c IMPLICIT NONE c----------------------------------------------------------------------- c Auteurs : L. Fairhead , P. Le Van . c c c Declarations : c -------------- #include "dimensions.h" #include "paramet.h" #include "control.h" #include "logic.h" #include "serre.h" #include "comdissnew.h" #include "sponge.h" c LOGICAL etatinit c c local: c ------ CHARACTER ch1*72,ch2*72,ch3*72,ch4*8 INTEGER tapeout REAL clonn,clatt,alphaxx,alphayy LOGICAL fxyhypbb INTEGER ierr c c ------------------------------------------------------------------- c c ......... Version du 29/04/97 .......... c c Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot, c tetatemp ajoutes pour la dissipation . c c Autre parametre ajoute en fin de liste : ** fxyhypb ** c c Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb. c Sinon , choix de fxynew , a derivee sinusoidale .. c c ...... etatinit = . TRUE. si defrun_new est appele dans ETAT0_LMD ou c LIMIT_LMD pour l'initialisation de start.dat (dic) et c de limit.dat ( dic) ........... c Sinon etatinit = . FALSE . c c Donc etatinit = .F. si on veut comparer les valeurs de alphax , c alphay,clon,clat, fxyhypb lues sur le fichier start avec c celles passees par run.def , au debut du gcm, apres l'appel a c lectba . c Ces parmetres definissant entre autres la grille et doivent etre c pareils et coherents , sinon il y aura divergence du gcm . c c----------------------------------------------------------------------- c initialisations: c ---------------- tapeout=6 c----------------------------------------------------------------------- c Parametres de controle du run: c----------------------------------------------------------------------- OPEN(99,file='run.def',status='old',form='formatted' . ,iostat=ierr) IF(ierr.EQ.0) THEN PRINT* READ (99,9000) ch1,ch2,ch3 WRITE(tapeout,9000) ch1,ch2,ch3 READ (99,9001) ch1,ch4 READ (99,*) nday WRITE(tapeout,9002) ch1 WRITE(tapeout,9005) 'nday ',nday READ (99,9001) ch1,ch4 READ (99,*) day_step WRITE(tapeout,9002) ch1 WRITE(tapeout,9005) 'day_step ',day_step READ (99,9001) ch1,ch4 READ (99,*) iperiod WRITE(tapeout,9002) ch1 WRITE(tapeout,9005) 'iperiod ',iperiod READ (99,9001) ch1,ch4 READ (99,*) iconser WRITE(tapeout,9002) ch1 WRITE(tapeout,9005) 'iconser ',iconser READ (99,9001) ch1,ch4 READ (99,*) iecri WRITE(tapeout,9002) ch1 WRITE(tapeout,9005) 'iecri ',iecri READ (99,9001) ch1,ch4 READ (99,*) periodav WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'periodav ',periodav READ (99,9001) ch1,ch4 READ (99,*) idissip WRITE(tapeout,9002) ch1 WRITE(tapeout,9005) 'idissip ',idissip ccc .... P. Le Van , modif le 29/04/97 .pour la dissipation ... ccc READ (99,9001) ch1,ch4 READ (99,*) lstardis WRITE(tapeout,9002) ch1 WRITE(tapeout,9004) 'lstardis ',lstardis READ (99,9001) ch1,ch4 READ (99,*) nitergdiv WRITE(tapeout,9002) ch1 WRITE(tapeout,9005) 'nitergdiv ',nitergdiv READ (99,9001) ch1,ch4 READ (99,*) nitergrot WRITE(tapeout,9002) ch1 WRITE(tapeout,9005) 'nitergrot ',nitergrot READ (99,9001) ch1,ch4 READ (99,*) niterh WRITE(tapeout,9002) ch1 WRITE(tapeout,9005) 'niterh ',niterh READ (99,9001) ch1,ch4 READ (99,*) tetagdiv WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'tetagdiv ',tetagdiv READ (99,9001) ch1,ch4 READ (99,*) tetagrot WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'tetagrot ',tetagrot READ (99,9001) ch1,ch4 READ (99,*) tetatemp WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'tetatemp ',tetatemp READ (99,9001) ch1,ch4 READ (99,*) coefdis WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'coefdis ',coefdis c c ............................................................... READ (99,9001) ch1,ch4 READ (99,*) iphysiq WRITE(tapeout,9002) ch1 WRITE(tapeout,9005) 'iphysiq ',iphysiq READ (99,9001) ch1,ch4 READ (99,*) purmats WRITE(tapeout,9002) ch1 WRITE(tapeout,9004) 'purmats ',purmats READ (99,9001) ch1,ch4 READ (99,*) grireg WRITE(tapeout,9002) ch1 WRITE(tapeout,9004) 'grireg ',grireg READ (99,9001) ch1,ch4 READ (99,*) physic WRITE(tapeout,9002) ch1 WRITE(tapeout,9004) 'physic ',physic ccc .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ... c READ (99,9001) ch1,ch4 READ (99,*) ecritphy WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'ecritphy ',ecritphy ccc .... P. Le Van , ajout le 7/03/95 .pour le zoom ... c ......... ( modif le 17/04/96 ) ......... c IF( etatinit ) GO TO 100 READ (99,9001) ch1,ch4 READ (99,*) clonn WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'clon ',clonn IF( ABS(clon - clonn).GE. 0.001 ) THEN PRINT *,' La valeur de clon passee par run.def est differente de * celle lue sur le fichier start ' STOP ENDIF c c READ (99,9001) ch1,ch4 READ (99,*) clatt WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'clat ',clatt IF( ABS(clat - clatt).GE. 0.001 ) THEN PRINT *,' La valeur de clat passee par run.def est differente de * celle lue sur le fichier start ' STOP ENDIF READ (99,9001) ch1,ch4 READ (99,*) alphaxx WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'alphax ',alphaxx IF( ABS(alphax - alphaxx).GE. 0.001 ) THEN PRINT *,' La valeur de alphax passee par run.def est differente * de celle lue sur le fichier start ' STOP ENDIF READ (99,9001) ch1,ch4 READ (99,*) alphayy WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'alphay ',alphayy IF( ABS(alphay - alphayy).GE. 0.001 ) THEN PRINT *,' La valeur de alphay passee par run.def est differente * de celle lue sur le fichier start ' STOP ENDIF c READ (99,9001) ch1,ch4 READ (99,*) fxyhypbb WRITE(tapeout,9002) ch1 WRITE(tapeout,9004) 'fxyhypbb ',fxyhypbb IF( .NOT.fxyhypb ) THEN IF( fxyhypbb ) THEN PRINT *,' ******** PBS DANS DEFRUN ******** ' PRINT *,' *** fxyhypb lu sur le fichier start est F ', * 'alors qu il est T sur run.def ***' STOP ENDIF ELSE IF( .NOT.fxyhypbb ) THEN PRINT *,' ******** PBS DANS DEFRUN ******** ' PRINT *,' *** fxyhypb lu sur le fichier start est T ', * 'alors qu il est F sur run.def **** ' STOP ENDIF ENDIF READ (99,9001) ch1,ch4 READ (99,*) callsponge WRITE(tapeout,9002) ch1 WRITE(tapeout,9004) 'callsponge ',callsponge READ (99,9001) ch1,ch4 READ (99,*) mode_sponge WRITE(tapeout,9002) ch1 WRITE(tapeout,9005) 'mode_sponge',mode_sponge READ (99,9001) ch1,ch4 READ (99,*) hsponge WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'hsponge ',hsponge READ (99,9001) ch1,ch4 READ (99,*) tetasponge WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'tetasponge ',tetasponge WRITE(tapeout,*) '-----------------------------------------------' WRITE(tapeout,*) '' WRITE(tapeout,*) '' c cc RETURN c .............. c 100 CONTINUE c READ (99,9001) ch1,ch4 READ (99,*) clon WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'clon ',clon c READ (99,9001) ch1,ch4 READ (99,*) clat WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'clat ',clat READ (99,9001) ch1,ch4 READ (99,*) alphax WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'alphaxi ',alphax READ (99,9001) ch1,ch4 READ (99,*) alphay WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'alphay ',alphay c READ (99,9001) ch1,ch4 READ (99,*) fxyhypb WRITE(tapeout,9002) ch1 WRITE(tapeout,9003) 'fxyhypb ',fxyhypb WRITE(tapeout,*) '-----------------------------------------------' WRITE(tapeout,*) '' WRITE(tapeout,*) '' cc ENDIF RETURN c 9000 FORMAT(3(/,a72)) 9001 FORMAT(/,a72,/,a9) 9002 FORMAT(/,a72) 9003 FORMAT(t3,a11,t14,f9.3) 9004 FORMAT(t3,a11,t14,l9) 9005 FORMAT(t3,a11,t14,i9) END