*=*=*=*= defrun_new.html =*=*=*=*
SUBROUTINE defrun_new

SUBROUTINE defrun_new


      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