Index: LMDZ5/trunk/bld.cfg
===================================================================
--- LMDZ5/trunk/bld.cfg	(revision 1943)
+++ LMDZ5/trunk/bld.cfg	(revision 1944)
@@ -28,4 +28,5 @@
 src::filtrez %SRC_PATH/filtrez
 src::bibio   %SRC_PATH/bibio
+src::dyn3d_common   %SRC_PATH/dyn3d_common
 src::cosp    %COSP
 src::ext_src %EXT_SRC
Index: LMDZ5/trunk/create_make_gcm
===================================================================
--- LMDZ5/trunk/create_make_gcm	(revision 1943)
+++ LMDZ5/trunk/create_make_gcm	(revision 1944)
@@ -48,4 +48,5 @@
 echo "LOCAL_DIR=`echo $localdir`"
 echo 'BIBIO    = $(LIBF)/bibio'
+echo 'DYN3D_COMMON   = $(LIBF)/dyn3d_common'
 echo "FILTRE   = filtre"
 echo "PHYS  = "
@@ -67,4 +68,5 @@
 echo 'L_PHY = -lphy$(PHYS) '
 echo 'L_BIBIO    = -lbibio'
+echo 'L_DYN3D_COMMON    = -ldyn3d_common'
 echo 'L_ADJNT    ='
 echo 'L_COSP     = -lcosp'
@@ -92,9 +94,9 @@
 echo
 #echo 'main : chimie $(DYN) bibio phys $(OPTION_DEP) '
-echo 'main : $(DYN) bibio phys $(OPTION_DEP) '
+echo 'main : $(DYN) bibio dyn3d_common phys $(OPTION_DEP) '
 echo '	cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\'
 echo '	cd $(LOCAL_DIR); \'
 echo '	$(COMPILE90) $(LIBF)/$(DIRMAIN)/$(SOURCE) -o $(PROG).o ; \'
-echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_COSP) $(L_PHY) $(L_DYN) $(L_BIBIO) $(L_DYN) $(L_FILTRE) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
+echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_COSP) $(L_PHY) $(L_DYN) $(L_BIBIO) $(L_DYN3D_COMMON) $(L_DYN) $(L_FILTRE) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
 echo
 echo 'dyn : $(LIBO)/libdyn$(DIM)d$(FLAG_PARA).a $(FILTRE)$(DIM)d'
@@ -105,4 +107,6 @@
 echo
 echo 'bibio : $(LIBO)/libbibio.a'
+echo
+echo 'dyn3d_common : $(LIBO)/libdyn3d_common.a'
 echo
 echo 'adjnt : $(LIBO)/libadjnt.a'
@@ -177,5 +181,5 @@
             strj=`echo $stri | tr [A-Z] [a-z]`
             str2=""
-            for dirinc in filtrez bibio grid dyn3d phydev $diri $diri/*/ ; do
+            for dirinc in filtrez bibio dyn3d_common grid dyn3d phydev $diri $diri/*/ ; do
 # Recherche dans l'ordre hierarchique inverse car seule la derniere
 # ligne est conservee
Index: LMDZ5/trunk/libf/dyn3d/defrun.F
===================================================================
--- LMDZ5/trunk/libf/dyn3d/defrun.F	(revision 1943)
+++ 	(revision )
@@ -1,496 +1,0 @@
-!
-! $Id$
-!
-c
-c
-      SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
-c
-      USE control_mod
- 
-      IMPLICIT NONE
-c-----------------------------------------------------------------------
-c     Auteurs :   L. Fairhead , P. Le Van  .
-c
-c     Arguments :
-c
-c     tapedef   :
-c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
-c     -metres  du zoom  avec  celles lues sur le fichier start .
-c      clesphy0 :  sortie  .
-c
-       LOGICAL etatinit
-       INTEGER tapedef
-
-       INTEGER        longcles
-       PARAMETER(     longcles = 20 )
-       REAL clesphy0( longcles )
-c
-c   Declarations :
-c   --------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "logic.h"
-#include "serre.h"
-#include "comdissnew.h"
-#include "clesph0.h"
-c
-c
-c   local:
-c   ------
-
-      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
-      INTEGER   tapeout
-      REAL clonn,clatt,grossismxx,grossismyy
-      REAL dzoomxx,dzoomyy,tauxx,tauyy
-      LOGICAL  fxyhypbb, ysinuss
-      INTEGER i
-      
-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 de tapedef : ** 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  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  grossismx ,
-c    grossismy,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( tapedef,file ='gcm.def',status='old',form='formatted')
-
-
-      READ (tapedef,9000) ch1,ch2,ch3
-      WRITE(tapeout,9000) ch1,ch2,ch3
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dayref
-      WRITE(tapeout,9001) ch1,'dayref'
-      WRITE(tapeout,*)    dayref
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    anneeref
-      WRITE(tapeout,9001) ch1,'anneeref'
-      WRITE(tapeout,*)    anneeref
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nday
-      WRITE(tapeout,9001) ch1,'nday'
-      WRITE(tapeout,*)    nday
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    day_step
-      WRITE(tapeout,9001) ch1,'day_step'
-      WRITE(tapeout,*)    day_step
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iperiod
-      WRITE(tapeout,9001) ch1,'iperiod'
-      WRITE(tapeout,*)    iperiod
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iapp_tracvl
-      WRITE(tapeout,9001) ch1,'iapp_tracvl'
-      WRITE(tapeout,*)    iapp_tracvl
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iconser
-      WRITE(tapeout,9001) ch1,'iconser'
-      WRITE(tapeout,*)    iconser
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iecri
-      WRITE(tapeout,9001) ch1,'iecri'
-      WRITE(tapeout,*)    iecri
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    periodav
-      WRITE(tapeout,9001) ch1,'periodav'
-      WRITE(tapeout,*)    periodav
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dissip_period
-      WRITE(tapeout,9001) ch1,'dissip_period'
-      WRITE(tapeout,*)    dissip_period
-
-ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
-ccc
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    lstardis
-      WRITE(tapeout,9001) ch1,'lstardis'
-      WRITE(tapeout,*)    lstardis
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nitergdiv
-      WRITE(tapeout,9001) ch1,'nitergdiv'
-      WRITE(tapeout,*)    nitergdiv
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nitergrot
-      WRITE(tapeout,9001) ch1,'nitergrot'
-      WRITE(tapeout,*)    nitergrot
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    niterh
-      WRITE(tapeout,9001) ch1,'niterh'
-      WRITE(tapeout,*)    niterh
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetagdiv
-      WRITE(tapeout,9001) ch1,'tetagdiv'
-      WRITE(tapeout,*)    tetagdiv
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetagrot
-      WRITE(tapeout,9001) ch1,'tetagrot'
-      WRITE(tapeout,*)    tetagrot
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetatemp
-      WRITE(tapeout,9001) ch1,'tetatemp'
-      WRITE(tapeout,*)    tetatemp
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    coefdis
-      WRITE(tapeout,9001) ch1,'coefdis'
-      WRITE(tapeout,*)    coefdis
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    purmats
-      WRITE(tapeout,9001) ch1,'purmats'
-      WRITE(tapeout,*)    purmats
-
-c    ...............................................................
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iflag_phys
-      WRITE(tapeout,9001) ch1,'iflag_phys'
-      WRITE(tapeout,*)    iflag_phys
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iphysiq
-      WRITE(tapeout,9001) ch1,'iphysiq'
-      WRITE(tapeout,*)    iphysiq
-
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    cycle_diurne
-      WRITE(tapeout,9001) ch1,'cycle_diurne'
-      WRITE(tapeout,*)    cycle_diurne
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    soil_model
-      WRITE(tapeout,9001) ch1,'soil_model'
-      WRITE(tapeout,*)    soil_model
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    new_oliq
-      WRITE(tapeout,9001) ch1,'new_oliq'
-      WRITE(tapeout,*)    new_oliq
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_orodr
-      WRITE(tapeout,9001) ch1,'ok_orodr'
-      WRITE(tapeout,*)    ok_orodr
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_orolf
-      WRITE(tapeout,9001) ch1,'ok_orolf'
-      WRITE(tapeout,*)    ok_orolf
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_limitvrai
-      WRITE(tapeout,9001) ch1,'ok_limitvrai'
-      WRITE(tapeout,*)    ok_limitvrai
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nbapp_rad
-      WRITE(tapeout,9001) ch1,'nbapp_rad'
-      WRITE(tapeout,*)    nbapp_rad
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iflag_con
-      WRITE(tapeout,9001) ch1,'iflag_con'
-      WRITE(tapeout,*)    iflag_con
-
-      DO i = 1, longcles
-       clesphy0(i) = 0.
-      ENDDO
-                          clesphy0(1) = REAL( iflag_con )
-                          clesphy0(2) = REAL( nbapp_rad )
-
-       IF( cycle_diurne  ) clesphy0(3) =  1.
-       IF(   soil_model  ) clesphy0(4) =  1.
-       IF(     new_oliq  ) clesphy0(5) =  1.
-       IF(     ok_orodr  ) clesphy0(6) =  1.
-       IF(     ok_orolf  ) clesphy0(7) =  1.
-       IF(  ok_limitvrai ) clesphy0(8) =  1.
-
-
-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 (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clonn
-      WRITE(tapeout,9001) ch1,'clon'
-      WRITE(tapeout,*)    clonn
-      IF( ABS(clon - clonn).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de clon passee par run.def est diffe
-     *rente de  celle lue sur le fichier  start '
-        STOP
-      ENDIF
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clatt
-      WRITE(tapeout,9001) ch1,'clat'
-      WRITE(tapeout,*)    clatt
-
-      IF( ABS(clat - clatt).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de clat passee par run.def est diffe
-     *rente de  celle lue sur le fichier  start '
-        STOP
-      ENDIF
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismxx
-      WRITE(tapeout,9001) ch1,'grossismx'
-      WRITE(tapeout,*)    grossismxx
-
-      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de grossismx passee par run.def est
-     , differente de celle lue sur le fichier  start '
-        STOP
-      ENDIF
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismyy
-      WRITE(tapeout,9001) ch1,'grossismy'
-      WRITE(tapeout,*)    grossismyy
-
-      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de grossismy passee par run.def est
-     , differente de celle lue sur le fichier  start '
-        STOP
-      ENDIF
-      
-      IF( grossismx.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismx < 1 .   *** '
-         STOP
-      ELSE
-         alphax = 1. - 1./ grossismx
-      ENDIF
-
-
-      IF( grossismy.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
-         STOP
-      ELSE
-         alphay = 1. - 1./ grossismy
-      ENDIF
-
-c
-c    alphax et alphay sont les anciennes formulat. des grossissements
-c
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    fxyhypbb
-      WRITE(tapeout,9001) ch1,'fxyhypbb'
-      WRITE(tapeout,*)    fxyhypbb
-
-      IF( .NOT.fxyhypb )  THEN
-           IF( fxyhypbb )     THEN
-            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
-            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est F'
-     *,      '                   alors  qu il est  T  sur  run.def  ***'
-              STOP
-           ENDIF
-      ELSE
-           IF( .NOT.fxyhypbb )   THEN
-            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
-            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est t'
-     *,      '                   alors  qu il est  F  sur  run.def  ***'
-              STOP
-           ENDIF
-      ENDIF
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomxx
-      WRITE(tapeout,9001) ch1,'dzoomx'
-      WRITE(tapeout,*)    dzoomxx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomyy
-      WRITE(tapeout,9001) ch1,'dzoomy'
-      WRITE(tapeout,*)    dzoomyy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauxx
-      WRITE(tapeout,9001) ch1,'taux'
-      WRITE(tapeout,*)    tauxx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauyy
-      WRITE(tapeout,9001) ch1,'tauy'
-      WRITE(tapeout,*)    tauyy
-
-      IF( fxyhypb )  THEN
-
-       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
-        WRITE(tapeout,*)' La valeur de dzoomx passee par run.def est dif
-     *ferente de celle lue sur le fichier  start '
-        CALL ABORT_gcm("defrun", "", 1)
-       ENDIF
-
-       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
-        WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
-     *ferente de celle lue sur le fichier  start '
-        CALL ABORT_gcm("defrun", "", 1)
-       ENDIF
-
-       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
-        WRITE(6,*)' La valeur de taux passee par run.def est differente
-     *  de celle lue sur le fichier  start '
-        CALL ABORT_gcm("defrun", "", 1)
-       ENDIF
-
-       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
-        WRITE(6,*)' La valeur de tauy passee par run.def est differente
-     *  de celle lue sur le fichier  start '
-        CALL ABORT_gcm("defrun", "", 1)
-       ENDIF
-
-      ENDIF
-      
-cc
-      IF( .NOT.fxyhypb  )  THEN
-        READ (tapedef,9001) ch1,ch4
-        READ (tapedef,*)    ysinuss
-        WRITE(tapeout,9001) ch1,'ysinus'
-        WRITE(tapeout,*)    ysinuss
-
-
-        IF( .NOT.ysinus )  THEN
-           IF( ysinuss )     THEN
-              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
-              WRITE(tapeout,*)'** ysinus lu sur le fichier start est F',
-     *       ' alors  qu il est  T  sur  run.def  ***'
-              STOP
-           ENDIF
-        ELSE
-           IF( .NOT.ysinuss )   THEN
-              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
-              WRITE(tapeout,*)'** ysinus lu sur le fichier start est T',
-     *       ' alors  qu il est  F  sur  run.def  ***'
-              STOP
-           ENDIF
-        ENDIF
-      ENDIF
-c
-      WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
-
-      CLOSE(tapedef)
-
-      RETURN
-c   ...............................................
-c
-100   CONTINUE
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clon
-      WRITE(tapeout,9001) ch1,'clon'
-      WRITE(tapeout,*)    clon
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clat
-      WRITE(tapeout,9001) ch1,'clat'
-      WRITE(tapeout,*)    clat
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismx
-      WRITE(tapeout,9001) ch1,'grossismx'
-      WRITE(tapeout,*)    grossismx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismy
-      WRITE(tapeout,9001) ch1,'grossismy'
-      WRITE(tapeout,*)    grossismy
-
-      IF( grossismx.LT.1. )  THEN
-        WRITE(tapeout,*) '***  ATTENTION !! grossismx < 1 .   *** '
-         STOP
-      ELSE
-         alphax = 1. - 1./ grossismx
-      ENDIF
-
-      IF( grossismy.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
-         STOP
-      ELSE
-         alphay = 1. - 1./ grossismy
-      ENDIF
-
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    fxyhypb
-      WRITE(tapeout,9001) ch1,'fxyhypb'
-      WRITE(tapeout,*)    fxyhypb
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomx
-      WRITE(tapeout,9001) ch1,'dzoomx'
-      WRITE(tapeout,*)    dzoomx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomy
-      WRITE(tapeout,9001) ch1,'dzoomy'
-      WRITE(tapeout,*)    dzoomy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    taux
-      WRITE(tapeout,9001) ch1,'taux'
-      WRITE(tapeout,*)    taux
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauy
-      WRITE(tapeout,9001) ch1,'tauy'
-      WRITE(tapeout,*)    tauy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ysinus
-      WRITE(tapeout,9001) ch1,'ysinus'
-      WRITE(tapeout,*)    ysinus
-       
-      WRITE(tapeout,*) ' alphax alphay defrun ',alphax,alphay
-c
-9000  FORMAT(3(/,a72))
-9001  FORMAT(/,a72,/,a12)
-cc
-      CLOSE(tapedef)
-
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3d/fyhyp.F
===================================================================
--- LMDZ5/trunk/libf/dyn3d/fyhyp.F	(revision 1943)
+++ 	(revision )
@@ -1,378 +1,0 @@
-!
-! $Id$
-!
-c
-c
-       SUBROUTINE fyhyp ( yzoomdeg, grossism, dzooma,tau  ,  
-     ,  rrlatu,yyprimu,rrlatv,yyprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
-     ,  champmin,champmax                                            ) 
-
-cc    ...  Version du 01/04/2001 ....
-
-       IMPLICIT NONE
-c
-c    ...   Auteur :  P. Le Van  ... 
-c
-c    .......    d'apres  formulations  de R. Sadourny  .......
-c
-c     Calcule les latitudes et derivees dans la grille du GCM pour une
-c     fonction f(y) a tangente  hyperbolique  .
-c
-c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois , etc)
-c     dzoom  etant  la distance totale de la zone du zoom ( en radians )
-c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom   
-c
-c
-c N.B : Il vaut mieux avoir : grossism * dzoom  <  pi/2  (radians) ,en lati.
-c      ********************************************************************
-c
-c
-#include "dimensions.h"
-#include "paramet.h"
-
-       INTEGER      nmax , nmax2
-       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
-c
-c
-c     .......  arguments  d'entree    .......
-c
-       REAL yzoomdeg, grossism,dzooma,tau 
-c         ( rentres  par  run.def )
-
-c     .......  arguments  de sortie   .......
-c
-       REAL rrlatu(jjp1), yyprimu(jjp1),rrlatv(jjm), yyprimv(jjm),
-     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
-
-c
-c     .....     champs  locaux    .....
-c
-     
-       REAL   dzoom
-       REAL(KIND=8) ylat(jjp1), yprim(jjp1)
-       REAL(KIND=8) yuv
-       REAL(KIND=8) yt(0:nmax2)
-       REAL(KIND=8) fhyp(0:nmax2),beta,Ytprim(0:nmax2),fxm(0:nmax2)
-       SAVE Ytprim, yt,Yf
-       REAL(KIND=8) Yf(0:nmax2),yypr(0:nmax2)
-       REAL(KIND=8) yvrai(jjp1), yprimm(jjp1),ylatt(jjp1)
-       REAL(KIND=8) pi,depi,pis2,epsilon,y0,pisjm
-       REAL(KIND=8) yo1,yi,ylon2,ymoy,Yprimin,champmin,champmax
-       REAL(KIND=8) yfi,Yf1,ffdy
-       REAL(KIND=8) ypn,deply,y00
-       SAVE y00, deply
-
-       INTEGER i,j,it,ik,iter,jlat
-       INTEGER jpn,jjpn
-       SAVE jpn
-       REAL(KIND=8) a0,a1,a2,a3,yi2,heavyy0,heavyy0m
-       REAL(KIND=8) fa(0:nmax2),fb(0:nmax2)
-       REAL y0min,y0max
-
-       REAL(KIND=8)     heavyside
-
-       pi       = 2. * ASIN(1.)
-       depi     = 2. * pi
-       pis2     = pi/2.
-       pisjm    = pi/ REAL(jjm)
-       epsilon  = 1.e-3
-       y0       =  yzoomdeg * pi/180. 
-
-       IF( dzooma.LT.1.)  THEN
-         dzoom = dzooma * pi
-       ELSEIF( dzooma.LT. 12. ) THEN
-         WRITE(6,*) ' Le param. dzoomy pour fyhyp est trop petit ! L aug
-     ,menter et relancer ! '
-         STOP 1
-       ELSE
-         dzoom = dzooma * pi/180.
-       ENDIF
-
-       WRITE(6,18)
-       WRITE(6,*) ' yzoom( rad.),grossism,tau,dzoom (radians)'
-       WRITE(6,24) y0,grossism,tau,dzoom
-
-       DO i = 0, nmax2 
-        yt(i) = - pis2  + REAL(i)* pi /nmax2
-       ENDDO
-
-       heavyy0m = heavyside( -y0 )
-       heavyy0  = heavyside(  y0 )
-       y0min    = 2.*y0*heavyy0m - pis2
-       y0max    = 2.*y0*heavyy0  + pis2
-
-       fa = 999.999
-       fb = 999.999
-       
-       DO i = 0, nmax2 
-        IF( yt(i).LT.y0 )  THEN
-         fa (i) = tau*  (yt(i)-y0+dzoom/2. )
-         fb(i) =   (yt(i)-2.*y0*heavyy0m +pis2) * ( y0 - yt(i) )
-        ELSEIF ( yt(i).GT.y0 )  THEN
-         fa(i) =   tau *(y0-yt(i)+dzoom/2. )
-         fb(i) = (2.*y0*heavyy0 -yt(i)+pis2) * ( yt(i) - y0 ) 
-       ENDIF
-        
-       IF( 200.* fb(i) .LT. - fa(i) )   THEN
-         fhyp ( i) = - 1.
-       ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
-         fhyp ( i) =   1.
-       ELSE  
-         fhyp(i) =  TANH ( fa(i)/fb(i) )
-       ENDIF
-
-       IF( yt(i).EQ.y0 )  fhyp(i) = 1.
-       IF(yt(i).EQ. y0min. OR.yt(i).EQ. y0max ) fhyp(i) = -1.
-
-       ENDDO
-
-cc  ....  Calcul  de  beta  ....
-c
-       ffdy   = 0.
-
-       DO i = 1, nmax2
-        ymoy    = 0.5 * ( yt(i-1) + yt( i ) )
-        IF( ymoy.LT.y0 )  THEN
-         fa(i)= tau * ( ymoy-y0+dzoom/2.) 
-         fb(i) = (ymoy-2.*y0*heavyy0m +pis2) * ( y0 - ymoy )
-        ELSEIF ( ymoy.GT.y0 )  THEN
-         fa(i)= tau * ( y0-ymoy+dzoom/2. ) 
-         fb(i) = (2.*y0*heavyy0 -ymoy+pis2) * ( ymoy - y0 )
-        ENDIF
-
-        IF( 200.* fb(i) .LT. - fa(i) )    THEN
-         fxm ( i) = - 1.
-        ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
-         fxm ( i) =   1.
-        ELSE
-         fxm(i) =  TANH ( fa(i)/fb(i) )
-        ENDIF
-         IF( ymoy.EQ.y0 )  fxm(i) = 1.
-         IF (ymoy.EQ. y0min. OR.yt(i).EQ. y0max ) fxm(i) = -1.
-         ffdy = ffdy + fxm(i) * ( yt(i) - yt(i-1) )
-
-        ENDDO
-
-        beta  = ( grossism * ffdy - pi ) / ( ffdy - pi )
-
-       IF( 2.*beta - grossism.LE. 0.)  THEN
-
-        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
-     ,tine fyhyp est mauvaise ! '
-        WRITE(6,*)'Modifier les valeurs de  grossismy ,tauy ou dzoomy',
-     , ' et relancer ! ***  '
-        CALL ABORT_GCM("FYHYP", "", 1)
-
-       ENDIF
-c
-c   .....  calcul  de  Ytprim   .....
-c
-       
-       DO i = 0, nmax2
-        Ytprim(i) = beta  + ( grossism - beta ) * fhyp(i)
-       ENDDO
-
-c   .....  Calcul  de  Yf     ........
-
-       Yf(0) = - pis2
-       DO i = 1, nmax2
-        yypr(i)    = beta + ( grossism - beta ) * fxm(i)
-       ENDDO
-
-       DO i=1,nmax2
-        Yf(i)   = Yf(i-1) + yypr(i) * ( yt(i) - yt(i-1) )
-       ENDDO
-
-c    ****************************************************************
-c
-c   .....   yuv  = 0.   si calcul des latitudes  aux pts.  U  .....
-c   .....   yuv  = 0.5  si calcul des latitudes  aux pts.  V  .....
-c
-      WRITE(6,18)
-c
-      DO 5000  ik = 1,4
-
-       IF( ik.EQ.1 )  THEN
-         yuv  = 0.
-         jlat = jjm + 1
-       ELSE IF ( ik.EQ.2 )  THEN
-         yuv  = 0.5
-         jlat = jjm 
-       ELSE IF ( ik.EQ.3 )  THEN
-         yuv  = 0.25
-         jlat = jjm 
-       ELSE IF ( ik.EQ.4 )  THEN
-         yuv  = 0.75
-         jlat = jjm 
-       ENDIF
-c
-       yo1   = 0.
-       DO 1500 j =  1,jlat
-        yo1   = 0.
-        ylon2 =  - pis2 + pisjm * ( REAL(j)  + yuv  -1.)  
-        yfi    = ylon2
-c
-       DO 250 it =  nmax2,0,-1
-        IF( yfi.GE.Yf(it))  GO TO 350
-250    CONTINUE
-       it = 0
-350    CONTINUE
-
-       yi = yt(it)
-       IF(it.EQ.nmax2)  THEN
-        it       = nmax2 -1
-        Yf(it+1) = pis2
-       ENDIF
-c  .................................................................
-c  ....  Interpolation entre  yi(it) et yi(it+1)   pour avoir Y(yi)  
-c      .....           et   Y'(yi)                             .....
-c  .................................................................
-
-       CALL coefpoly ( Yf(it),Yf(it+1),Ytprim(it), Ytprim(it+1),   
-     ,                  yt(it),yt(it+1) ,   a0,a1,a2,a3   )      
-
-       Yf1     = Yf(it)
-       Yprimin = a1 + 2.* a2 * yi + 3.*a3 * yi *yi
-
-       DO 500 iter = 1,300
-         yi = yi - ( Yf1 - yfi )/ Yprimin
-
-        IF( ABS(yi-yo1).LE.epsilon)  GO TO 550
-         yo1      = yi
-         yi2      = yi * yi
-         Yf1      = a0 +  a1 * yi +     a2 * yi2  +     a3 * yi2 * yi
-         Yprimin  =       a1      + 2.* a2 *  yi  + 3.* a3 * yi2
-500   CONTINUE
-        WRITE(6,*) ' Pas de solution ***** ',j,ylon2,iter
-         STOP 2
-550   CONTINUE
-c
-       Yprimin   = a1  + 2.* a2 *  yi   + 3.* a3 * yi* yi
-       yprim(j)  = pi / ( jjm * Yprimin )
-       yvrai(j)  = yi 
-
-1500    CONTINUE
-
-       DO j = 1, jlat -1
-        IF( yvrai(j+1). LT. yvrai(j) )  THEN
-         WRITE(6,*) ' PBS. avec  rlat(',j+1,') plus petit que rlat(',j,
-     ,  ')'
-         STOP 3
-        ENDIF
-       ENDDO
-
-       WRITE(6,*) 'Reorganisation des latitudes pour avoir entre - pi/2'
-     , ,' et  pi/2 '
-c
-        IF( ik.EQ.1 )   THEN
-           ypn = pis2 
-          DO j = jlat,1,-1
-           IF( yvrai(j).LE. ypn ) GO TO 1502
-          ENDDO
-1502     CONTINUE
-
-         jpn   = j
-         y00   = yvrai(jpn)
-         deply = pis2 -  y00
-        ENDIF
-
-         DO  j = 1, jjm +1 - jpn
-           ylatt (j)  = -pis2 - y00  + yvrai(jpn+j-1)
-           yprimm(j)  = yprim(jpn+j-1)
-         ENDDO
-
-         jjpn  = jpn
-         IF( jlat.EQ. jjm ) jjpn = jpn -1
-
-         DO j = 1,jjpn 
-          ylatt (j + jjm+1 -jpn) = yvrai(j) + deply
-          yprimm(j + jjm+1 -jpn) = yprim(j)
-         ENDDO
-
-c      ***********   Fin de la reorganisation     *************
-c
- 1600   CONTINUE
-
-       DO j = 1, jlat
-          ylat(j) =  ylatt( jlat +1 -j )
-         yprim(j) = yprimm( jlat +1 -j )
-       ENDDO
-  
-        DO j = 1, jlat
-         yvrai(j) = ylat(j)*180./pi
-        ENDDO
-
-        IF( ik.EQ.1 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT  en U   apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rrlatu(j) =  ylat( j )
-           yyprimu(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 2 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*) ' YLAT   en V  apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*)' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rrlatv(j) =  ylat( j )
-           yyprimv(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 3 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT  en U + 0.75  apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rlatu2(j) =  ylat( j )
-           yprimu2(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 4 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT en U + 0.25  apres ( en  deg. ) '
-c         WRITE(6,68)(yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,68) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rlatu1(j) =  ylat( j )
-           yprimu1(j) = yprim( j )
-          ENDDO
-
-        ENDIF
-
-5000   CONTINUE
-c
-        WRITE(6,18)
-c
-c  .....     fin de la boucle  do 5000 .....
-
-        DO j = 1, jjm
-         ylat(j) = rrlatu(j) - rrlatu(j+1)
-        ENDDO
-        champmin =  1.e12
-        champmax = -1.e12
-        DO j = 1, jjm
-         champmin = MIN( champmin, ylat(j) )
-         champmax = MAX( champmax, ylat(j) )
-        ENDDO
-         champmin = champmin * 180./pi
-         champmax = champmax * 180./pi
-
-24     FORMAT(2x,'Parametres yzoom,gross,tau ,dzoom pour fyhyp ',4f8.3)
-18      FORMAT(/)
-68      FORMAT(1x,7f9.2)
-
-        RETURN
-        END
Index: LMDZ5/trunk/libf/dyn3d/grid_atob.F
===================================================================
--- LMDZ5/trunk/libf/dyn3d/grid_atob.F	(revision 1943)
+++ 	(revision )
@@ -1,971 +1,0 @@
-!
-! $Id$
-!
-      SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie)
-c=======================================================================
-c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
-c
-c Methode naive pour transformer un champ d'une grille fine a une
-c grille grossiere. Je considere que les nouveaux points occupent
-c une zone adjacente qui comprend un ou plusieurs anciens points
-c
-c Aucune ponderation est consideree (voir grille_p)
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        sortie: champ de sortie deja transforme
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL number(2200,1100)
-      REAL distans(2200*1100)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-c Calculer les limites des zones des nouveaux points
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c Determiner la zone sur laquelle chaque ancien point se trouve
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               number(ii,jj) = number(ii,jj) + 1.0
-               sortie(ii,jj) = sortie(ii,jj) + entree(i,j)
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c Si aucun ancien point tombe sur une zone, c'est un probleme
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (number(i,j) .GT. 0.001) THEN
-         sortie(i,j) = sortie(i,j) / number(i,j)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-ccc         CALL ABORT_GCM("", "", 1)
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         sortie(i,j) = entree(i_proche,j_proche)
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-      SUBROUTINE grille_p(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie)
-c=======================================================================
-c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
-c
-c Methode naive pour transformer un champ d'une grille fine a une
-c grille grossiere. Je considere que les nouveaux points occupent
-c une zone adjacente qui comprend un ou plusieurs anciens points
-c
-c Consideration de la distance des points (voir grille_m)
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        sortie: champ de sortie deja transforme
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(200),d(200)
-      REAL number(400,200)
-      INTEGER indx(400,200), indy(400,200)
-      REAL dist(400,200), distsom(400,200)
-c
-      IF (imar.GT.400 .OR. jmar.GT.200) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-      IF (imdep.GT.400 .OR. jmdep.GT.200) THEN
-         PRINT*, 'imdep ou jmdep trop grand', imdep, jmdep
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-c calculer les bords a et b de la nouvelle grille
-c
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-c
-c calculer les bords c et d de la nouvelle grille
-c
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-c
-c trouver les indices (indx,indy) de la nouvelle grille sur laquelle
-c un point de l'ancienne grille est tombe.
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               indx(i,j) = ii
-               indy(i,j) = jj
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c faire une verification
-c
-
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         IF (indx(i,j).GT.imar .OR. indy(i,j).GT.jmar) THEN
-            PRINT*, 'Probleme grave,i,j,indx,indy=',
-     .              i,j,indx(i,j),indy(i,j)
-            call abort_gcm("", "", 1)
-         ENDIF
-      ENDDO
-      ENDDO
-
-c
-c calculer la distance des anciens points avec le nouveau point,
-c on prend ensuite une sorte d'inverse pour ponderation.
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         distsom(i,j) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         dist(i,j) = SQRT ( (xdata(i)-x(indx(i,j)))**2
-     .                     +(ydata(j)-y(indy(i,j)))**2 )
-         distsom(indx(i,j),indy(i,j)) = distsom(indx(i,j),indy(i,j))
-     .                                  + dist(i,j)
-         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j)) +1.
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         dist(i,j) = 1.0 - dist(i,j)/distsom(indx(i,j),indy(i,j))
-      ENDDO
-      ENDDO
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         sortie(indx(i,j),indy(i,j)) = sortie(indx(i,j),indy(i,j))
-     .                                 + entree(i,j) * dist(i,j)
-         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j))
-     .                                 + dist(i,j)
-      ENDDO
-      ENDDO
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (number(i,j) .GT. 0.001) THEN
-         sortie(i,j) = sortie(i,j) / number(i,j)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT_GCM("", "", 1)
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-
-      SUBROUTINE mask_c_o(imdep, jmdep, xdata, ydata, relief,
-     .                    imar, jmar, x, y, mask)
-c=======================================================================
-c z.x.li (le 1 avril 1994): A partir du champ de relief, on fabrique
-c                           un champ indicateur (masque) terre/ocean
-c                           terre:1; ocean:0
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL relief(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL mask(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL num_tot(2200,1100), num_oce(2200,1100)
-c
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_oce(i,j) = 0.0
-         num_tot(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-               IF (.NOT. ( relief(i,j) - 0.9. GE. 1.e-5 ) )
-     .             num_oce(ii,jj) = num_oce(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-c
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (num_tot(i,j) .GT. 0.001) THEN
-           IF ( num_oce(i,j)/num_tot(i,j) - 0.5 .GE. 1.e-5 ) THEN
-              mask(i,j) = 0.
-           ELSE
-              mask(i,j) = 1.
-           ENDIF
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT_GCM("", "", 1)
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-c
-c
-
-
-      SUBROUTINE rugosite(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie, mask)
-c=======================================================================
-c z.x.li (le 1 avril 1994): Transformer la longueur de rugosite d'une
-c grille fine a une grille grossiere. Sur l'ocean, on impose une valeur
-c fixe (0.001m).
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar), mask(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(400),d(400)
-      REAL num_tot(400,400)
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      IF (imar.GT.400 .OR. jmar.GT.400) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_tot(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              sortie(ii,jj)  = sortie(ii,jj) + LOG(entree(i,j))
-              num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-       IF (NINT(mask(i,j)).EQ.1) THEN
-         IF (num_tot(i,j) .GT. 0.0) THEN
-            sortie(i,j) = sortie(i,j) / num_tot(i,j)
-            sortie(i,j) = EXP(sortie(i,j))
-         ELSE
-            PRINT*, 'probleme,i,j=', i,j
-ccc            CALL ABORT_GCM("", "", 1)
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         sortie(i,j) = entree(i_proche,j_proche)
-         ENDIF
-       ELSE
-         sortie(i,j) = 0.001
-       ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-
-
-      SUBROUTINE sea_ice(imdep, jmdep, xdata, ydata, glace01,
-     .                    imar, jmar, x, y, frac_ice)
-c=======================================================================
-c z.x.li (le 1 avril 1994): Transformer un champ d'indicateur de la
-c glace (1, sinon 0) d'une grille fine a un champ de fraction de glace
-c (entre 0 et 1) dans une grille plus grossiere.
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL glace01(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL frac_ice(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(400),d(400)
-      REAL num_tot(400,400), num_ice(400,400)
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      IF (imar.GT.400 .OR. jmar.GT.400) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_ice(i,j) = 0.0
-         num_tot(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-             num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-              IF (NINT(glace01(i,j)).EQ.1 ) 
-     .       num_ice(ii,jj) = num_ice(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (num_tot(i,j) .GT. 0.001) THEN
-           IF (num_ice(i,j).GT.0.001) THEN
-            frac_ice(i,j) = num_ice(i,j) / num_tot(i,j)
-           ELSE
-              frac_ice(i,j) = 0.0
-           ENDIF
-         ELSE
-           PRINT*, 'probleme,i,j=', i,j
-ccc           CALL ABORT_GCM("", "", 1)
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         IF (NINT(glace01(i_proche,j_proche)).EQ.1 ) THEN
-            frac_ice(i,j) = 1.0
-         ELSE
-            frac_ice(i,j) = 0.0
-         ENDIF
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-      SUBROUTINE rugsoro(imrel, jmrel, xrel, yrel, relief,
-     .                    immod, jmmod, xmod, ymod, rugs)
-c=======================================================================
-c Calculer la longueur de rugosite liee au relief en utilisant
-c l'ecart-type dans une maille de 1x1
-C=======================================================================
-      IMPLICIT none
-c
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      REAL amin, AMAX
-c
-      INTEGER imrel, jmrel
-      REAL xrel(imrel),yrel(jmrel)
-      REAL relief(imrel,jmrel)
-c
-      INTEGER immod, jmmod
-      REAL xmod(immod),ymod(jmmod)
-      REAL rugs(immod,jmmod)
-c
-      INTEGER imtmp, jmtmp
-      PARAMETER (imtmp=360,jmtmp=180)
-      REAL xtmp(imtmp), ytmp(jmtmp)
-      REAL(KIND=8) cham1tmp(imtmp,jmtmp), cham2tmp(imtmp,jmtmp)
-      REAL zzzz
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL number(2200,1100)
-c
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-c
-      IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN
-         PRINT*, 'immod ou jmmod trop grand', immod, jmmod
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-c Calculs intermediares:
-c
-      xtmp(1) = -180.0 + 360.0/REAL(imtmp) / 2.0
-      DO i = 2, imtmp
-         xtmp(i) = xtmp(i-1) + 360.0/REAL(imtmp)
-      ENDDO
-      DO i = 1, imtmp
-         xtmp(i) = xtmp(i) /180.0 * 4.0*ATAN(1.0)
-      ENDDO
-      ytmp(1) = -90.0 + 180.0/REAL(jmtmp) / 2.0
-      DO j = 2, jmtmp
-         ytmp(j) = ytmp(j-1) + 180.0/REAL(jmtmp)
-      ENDDO
-      DO j = 1, jmtmp
-         ytmp(j) = ytmp(j) /180.0 * 4.0*ATAN(1.0)
-      ENDDO
-c
-      a(1) = xtmp(1) - (xtmp(2)-xtmp(1))/2.0
-      b(1) = (xtmp(1)+xtmp(2))/2.0
-      DO i = 2, imtmp-1
-         a(i) = b(i-1)
-         b(i) = (xtmp(i)+xtmp(i+1))/2.0
-      ENDDO
-      a(imtmp) = b(imtmp-1)
-      b(imtmp) = xtmp(imtmp) + (xtmp(imtmp)-xtmp(imtmp-1))/2.0
-
-      c(1) = ytmp(1) - (ytmp(2)-ytmp(1))/2.0
-      d(1) = (ytmp(1)+ytmp(2))/2.0
-      DO j = 2, jmtmp-1
-         c(j) = d(j-1)
-         d(j) = (ytmp(j)+ytmp(j+1))/2.0
-      ENDDO
-      c(jmtmp) = d(jmtmp-1)
-      d(jmtmp) = ytmp(jmtmp) + (ytmp(jmtmp)-ytmp(jmtmp-1))/2.0
-
-      DO i = 1, imtmp
-      DO j = 1, jmtmp
-         number(i,j) = 0.0
-         cham1tmp(i,j) = 0.0
-         cham2tmp(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imtmp
-      DO jj = 1, jmtmp
-        DO i = 1, imrel
-         IF( ( xrel(i)-a(ii).GE.1.e-5.AND.xrel(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xrel(i)-a(ii).LE.1.e-5.AND.xrel(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmrel
-          IF( (yrel(j)-c(jj).GE.1.e-5.AND.yrel(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  yrel(j)-c(jj).LE.1.e-5.AND.yrel(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              number(ii,jj) = number(ii,jj) + 1.0
-              cham1tmp(ii,jj) = cham1tmp(ii,jj) + relief(i,j)
-              cham2tmp(ii,jj) = cham2tmp(ii,jj) 
-     .                              + relief(i,j)*relief(i,j)
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-      DO i = 1, imtmp
-      DO j = 1, jmtmp
-         IF (number(i,j) .GT. 0.001) THEN
-         cham1tmp(i,j) = cham1tmp(i,j) / number(i,j)
-         cham2tmp(i,j) = cham2tmp(i,j) / number(i,j)
-         zzzz=cham2tmp(i,j)-cham1tmp(i,j)**2
-         if (zzzz .lt. 0.0) then
-           if (zzzz .gt. -7.5) then
-             zzzz = 0.0
-             print*,'Pb rugsoro, -7.5 < zzzz < 0, => zzz = 0.0'
-           else
-              stop 'Pb rugsoro, zzzz <-7.5'
-           endif
-         endif
-         cham2tmp(i,j) = SQRT(zzzz)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT_GCM("", "", 1)
-         ENDIF
-      ENDDO
-      ENDDO
-c
-      amin = cham2tmp(1,1)
-      AMAX = cham2tmp(1,1)
-      DO j = 1, jmtmp
-      DO i = 1, imtmp
-         IF (cham2tmp(i,j).GT.AMAX) AMAX = cham2tmp(i,j)
-         IF (cham2tmp(i,j).LT.amin) amin = cham2tmp(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Ecart-type 1x1:', amin, AMAX
-c
-c
-c
-      a(1) = xmod(1) - (xmod(2)-xmod(1))/2.0
-      b(1) = (xmod(1)+xmod(2))/2.0
-      DO i = 2, immod-1
-         a(i) = b(i-1)
-         b(i) = (xmod(i)+xmod(i+1))/2.0
-      ENDDO
-      a(immod) = b(immod-1)
-      b(immod) = xmod(immod) + (xmod(immod)-xmod(immod-1))/2.0
-
-      c(1) = ymod(1) - (ymod(2)-ymod(1))/2.0
-      d(1) = (ymod(1)+ymod(2))/2.0
-      DO j = 2, jmmod-1
-         c(j) = d(j-1)
-         d(j) = (ymod(j)+ymod(j+1))/2.0
-      ENDDO
-      c(jmmod) = d(jmmod-1)
-      d(jmmod) = ymod(jmmod) + (ymod(jmmod)-ymod(jmmod-1))/2.0
-c
-      DO i = 1, immod
-      DO j = 1, jmmod
-         number(i,j) = 0.0
-         rugs(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, immod
-      DO jj = 1, jmmod
-        DO i = 1, imtmp
-         IF( ( xtmp(i)-a(ii).GE.1.e-5.AND.xtmp(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xtmp(i)-a(ii).LE.1.e-5.AND.xtmp(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmtmp
-          IF( (ytmp(j)-c(jj).GE.1.e-5.AND.ytmp(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ytmp(j)-c(jj).LE.1.e-5.AND.ytmp(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              number(ii,jj) = number(ii,jj) + 1.0
-              rugs(ii,jj) = rugs(ii,jj)
-     .                       + LOG(MAX(0.001_8,cham2tmp(i,j)))
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-      DO i = 1, immod
-      DO j = 1, jmmod
-         IF (number(i,j) .GT. 0.001) THEN
-         rugs(i,j) = rugs(i,j) / number(i,j)
-         rugs(i,j) = EXP(rugs(i,j))
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-ccc         CALL ABORT_GCM("", "", 1)
-         CALL dist_sphe(xmod(i),ymod(j),xtmp,ytmp,imtmp,jmtmp,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imtmp*jmtmp,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imtmp*jmtmp
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imtmp + 1
-         i_proche = ij_proche - (j_proche-1)*imtmp
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         rugs(i,j) = LOG(MAX(0.001_8,cham2tmp(i_proche,j_proche)))
-         ENDIF
-      ENDDO
-      ENDDO
-c
-      amin = rugs(1,1)
-      AMAX = rugs(1,1)
-      DO j = 1, jmmod
-      DO i = 1, immod
-         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
-         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Ecart-type du modele:', amin, AMAX
-c
-      DO j = 1, jmmod
-      DO i = 1, immod
-         rugs(i,j) = rugs(i,j) / AMAX * 20.0
-      ENDDO
-      ENDDO
-c
-      amin = rugs(1,1)
-      AMAX = rugs(1,1)
-      DO j = 1, jmmod
-      DO i = 1, immod
-         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
-         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Longueur de rugosite du modele:', amin, AMAX
-c
-      RETURN
-      END
-c
-      SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,im,jm,distance)
-c
-c Auteur: Laurent Li (le 30 decembre 1996)
-c
-c Ce programme calcule la distance minimale (selon le grand cercle)
-c entre deux points sur la terre
-c
-c Input:
-      INTEGER im, jm ! dimensions
-      REAL rf_lon ! longitude du point de reference (degres)
-      REAL rf_lat ! latitude du point de reference (degres)
-      REAL rlon(im), rlat(jm) ! longitude et latitude des points
-c
-c Output:
-      REAL distance(im,jm) ! distances en metre
-c
-      REAL rlon1, rlat1
-      REAL rlon2, rlat2
-      REAL dist
-      REAL pa, pb, p, pi
-c
-      REAL radius
-      PARAMETER (radius=6371229.)
-c
-      pi = 4.0 * ATAN(1.0)
-c
-      DO 9999 j = 1, jm
-      DO 9999 i = 1, im
-c
-      rlon1=rf_lon
-      rlat1=rf_lat
-      rlon2=rlon(i)
-      rlat2=rlat(j)
-      pa = pi/2.0 - rlat1*pi/180.0 ! dist. entre pole n et point a
-      pb = pi/2.0 - rlat2*pi/180.0 ! dist. entre pole n et point b
-      p = (rlon1-rlon2)*pi/180.0 ! angle entre a et b (leurs meridiens)
-c
-      dist = ACOS( COS(pa)*COS(pb) + SIN(pa)*SIN(pb)*COS(p))
-      dist = radius * dist
-      distance(i,j) = dist
-c
- 9999 CONTINUE
-c
-      END
Index: LMDZ5/trunk/libf/dyn3d/grid_noro.F
===================================================================
--- LMDZ5/trunk/libf/dyn3d/grid_noro.F	(revision 1943)
+++ 	(revision )
@@ -1,521 +1,0 @@
-!
-! $Id$
-!
-c
-c
-      SUBROUTINE grid_noro(imdep, jmdep, xdata, ydata, zdata,
-     .             imar, jmar, x, y,
-     .             zphi,zmea,zstd,zsig,zgam,zthe,
-     .             zpic,zval,mask)
-c=======================================================================
-c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
-c
-c      Compute the Parameters of the SSO scheme as described in
-c      LOTT & MILLER (1997) and LOTT(1999).
-c      Target points are on a rectangular grid:
-c      iim+1 latitudes including North and South Poles;
-c      jjm+1 longitudes, with periodicity jjm+1=1.
-c      aux poles.  At the poles the fields value is repeated
-c      jjm+1 time.
-c      The parameters a,b,c,d represent the limite of the target
-c      gridpoint region. The means over this region are calculated
-c      from USN data, ponderated by a weight proportional to the 
-c      surface occupated by the data inside the model gridpoint area.
-c      In most circumstances, this weight is the ratio between the
-c      surface of the USN gridpoint area and the surface of the
-c      model gridpoint area. 
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X and Y input field
-c        xdata, ydata: coordinates X and Y input field
-c        zdata: Input field
-c        In this version it is assumed that the entry data come from
-c        the USNavy dataset: imdep=iusn=2160, jmdep=jusn=1080.
-c OUTPUT:
-c        imar, jmar: dimensions X and Y Output field
-c        x, y: ccordinates  X and Y Output field.
-c             zmea:  Mean orographie   
-c             zstd:  Standard deviation
-c             zsig:  Slope
-c             zgam:  Anisotropy
-c             zthe:  Orientation of the small axis
-c             zpic:  Maximum altitude
-c             zval:  Minimum altitude
-C=======================================================================
-
-      IMPLICIT INTEGER (I,J)
-      IMPLICIT REAL(X,Z) 
-      
-	  parameter(iusn=2160,jusn=1080,iext=216, epsfra = 1.e-5)
-#include "dimensions.h"
-	  REAL xusn(iusn+2*iext),yusn(jusn+2)	
-      REAL zusn(iusn+2*iext,jusn+2)
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL zdata(imdep,jmdep)
-c
-      INTEGER imar, jmar
-  
-C INTERMEDIATE FIELDS  (CORRELATIONS OF OROGRAPHY GRADIENT)
-
-      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
-      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
-      REAL weight(iim+1,jjm+1)
-
-C CORRELATIONS OF USN OROGRAPHY GRADIENTS
-
-      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
-      REAL zxtzyusn(iusn+2*iext,jusn+2)
-      REAL x(imar+1),y(jmar),zphi(imar+1,jmar)
-      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
-      REAL zmea0(imar+1,jmar) ! GK211005 (CG)
-      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
-      REAL zpic(imar+1,jmar),zval(imar+1,jmar)
-cx$$ PB     integer mask(imar+1,jmar)
-      real mask(imar+1,jmar), mask_tmp(imar+1,jmar)
-      real num_tot(2200,1100),num_lan(2200,1100)
-c
-      REAL a(2200),b(2200),c(1100),d(1100)
-      logical masque_lu
-c
-      print *,' parametres de l orographie a l echelle sous maille' 
-      xpi=acos(-1.)
-      rad    = 6 371 229.
-      zdeltay=2.*xpi/REAL(jusn)*rad
-c
-c utilise-t'on un masque lu?
-c
-      masque_lu = .true.
-      if (maxval(mask) == -99999 .and. minval(mask) == -99999) then
-        masque_lu= .false.
-        masque = 0.0
-      endif
-      write(*,*)'Masque lu', masque_lu
-c
-c  quelques tests de dimensions:
-c    
-c
-      if(iim.ne.imar) STOP 'Problem dim. x'
-      if(jjm.ne.jmar-1) STOP 'Problem dim. y'
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar or jmar too big', imar, jmar
-         CALL ABORT_GCM("GRID_NORO", "", 1)
-      ENDIF
-
-      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
-         print *,' imdep or jmdep bad dimensions:',imdep,jmdep
-         call abort_gcm("grid_noro", "", 1)
-      ENDIF
-
-      IF(imar+1.ne.iim+1.or.jmar.ne.jjm+1)THEN
-        print *,' imar or jmar bad dimensions:',imar,jmar
-        call abort_gcm("grid_noro", "", 1)
-      ENDIF
-
-
-c      print *,'xdata:',xdata
-c      print *,'ydata:',ydata
-c      print *,'x:',x
-c      print *,'y:',y
-c
-C  EXTENSION OF THE USN DATABASE TO POCEED COMPUTATIONS AT
-C  BOUNDARIES:
-c
-      DO j=1,jusn
-        yusn(j+1)=ydata(j)
-      DO i=1,iusn
-        zusn(i+iext,j+1)=zdata(i,j)
-        xusn(i+iext)=xdata(i)
-      ENDDO
-      DO i=1,iext
-        zusn(i,j+1)=zdata(iusn-iext+i,j)
-        xusn(i)=xdata(iusn-iext+i)-2.*xpi
-        zusn(iusn+iext+i,j+1)=zdata(i,j)
-        xusn(iusn+iext+i)=xdata(i)+2.*xpi
-      ENDDO
-      ENDDO
-
-        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
-        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
-       DO i=1,iusn/2+iext
-        zusn(i,1)=zusn(i+iusn/2,2)
-        zusn(i+iusn/2+iext,1)=zusn(i,2)
-        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
-        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
-       ENDDO
-c  
-c COMPUTE LIMITS OF MODEL GRIDPOINT AREA
-C     ( REGULAR GRID)
-c
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar+1) = b(imar)
-      b(imar+1) = x(imar+1) + (x(imar+1)-x(imar))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-c
-c  initialisations:
-c
-      DO i = 1, imar+1
-      DO j = 1, jmar
-         weight(i,j) = 0.0
-         zxtzx(i,j)  = 0.0
-         zytzy(i,j)  = 0.0
-         zxtzy(i,j)  = 0.0
-         ztz(i,j)    = 0.0
-         zmea(i,j)   = 0.0
-         zpic(i,j)  =-1.E+10
-         zval(i,j)  = 1.E+10
-      ENDDO
-      ENDDO
-c
-c  COMPUTE SLOPES CORRELATIONS ON USN GRID
-c
-         DO j = 1,jusn+2 
-         DO i = 1, iusn+2*iext
-            zytzyusn(i,j)=0.0
-            zxtzxusn(i,j)=0.0
-            zxtzyusn(i,j)=0.0
-         ENDDO
-         ENDDO
-
-
-         DO j = 2,jusn+1 
-            zdeltax=zdeltay*cos(yusn(j))
-         DO i = 2, iusn+2*iext-1
-            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
-            zxtzxusn(i,j)=(zusn(i+1,j)-zusn(i-1,j))**2/zdeltax**2
-            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
-     *                   *(zusn(i+1,j)-zusn(i-1,j))/zdeltax
-         ENDDO
-         ENDDO
-c
-c  SUMMATION OVER GRIDPOINT AREA
-c 
-      zleny=xpi/REAL(jusn)*rad
-      xincr=xpi/2./REAL(jusn)
-       DO ii = 1, imar+1
-       DO jj = 1, jmar
-       num_tot(ii,jj)=0.
-       num_lan(ii,jj)=0.
-c        PRINT *,' iteration ii jj:',ii,jj
-         DO j = 2,jusn+1 
-c         DO j = 3,jusn 
-            zlenx=zleny*cos(yusn(j))
-            zdeltax=zdeltay*cos(yusn(j))
-            zbordnor=(c(jj)-yusn(j)+xincr)*rad
-            zbordsud=(yusn(j)-d(jj)+xincr)*rad
-            weighy=AMAX1(0.,
-     *             amin1(zbordnor,zbordsud,zleny))
-         IF(weighy.ne.0)THEN
-         DO i = 2, iusn+2*iext-1
-            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
-            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
-            weighx=AMAX1(0.,
-     *             amin1(zbordest,zbordoue,zlenx))
-            IF(weighx.ne.0)THEN
-            num_tot(ii,jj)=num_tot(ii,jj)+1.0
-            if(zusn(i,j).ge.1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
-            weight(ii,jj)=weight(ii,jj)+weighx*weighy
-            zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
-            zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
-            zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
-            ztz(ii,jj)  =ztz(ii,jj)  +zusn(i,j)*zusn(i,j)*weighx*weighy
-c mean
-            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
-c peacks
-            zpic(ii,jj)=amax1(zpic(ii,jj),zusn(i,j))
-c valleys
-            zval(ii,jj)=amin1(zval(ii,jj),zusn(i,j))
-            ENDIF
-         ENDDO
-         ENDIF
-         ENDDO
-       ENDDO
-       ENDDO
-c
-c  COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND
-C  LOTT (1999) SSO SCHEME.
-c
-      zllmmea=0.
-      zllmstd=0.
-      zllmsig=0.
-      zllmgam=0.
-      zllmpic=0.
-      zllmval=0.
-      zllmthe=0.
-      zminthe=0.
-c     print 100,' '
-c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
-       DO ii = 1, imar+1
-       DO jj = 1, jmar
-         IF (weight(ii,jj) .NE. 0.0) THEN
-c  Mask
-cx$$           if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
-cx$$             mask(ii,jj)=1
-cx$$           else
-cx$$             mask(ii,jj)=0
-cx$$           ENDIF
-             if (.not. masque_lu) then
-               mask(ii,jj) = num_lan(ii,jj)/num_tot(ii,jj)
-             endif
-c  Mean Orography:
-           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
-           zxtzx(ii,jj)=zxtzx(ii,jj)/weight(ii,jj)
-           zytzy(ii,jj)=zytzy(ii,jj)/weight(ii,jj)
-           zxtzy(ii,jj)=zxtzy(ii,jj)/weight(ii,jj)
-           ztz(ii,jj)  =ztz(ii,jj)/weight(ii,jj)
-c  Standard deviation:
-           zstd(ii,jj)=sqrt(AMAX1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
-         ELSE
-            PRINT*, 'probleme,ii,jj=', ii,jj
-         ENDIF
-       ENDDO
-       ENDDO
-
-C CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES:
-
-       DO ii = 1, imar+1
-         zxtzx(ii,1)=zxtzx(ii,2)
-         zxtzx(ii,jmar)=zxtzx(ii,jmar-1)
-         zxtzy(ii,1)=zxtzy(ii,2)
-         zxtzy(ii,jmar)=zxtzy(ii,jmar-1)
-         zytzy(ii,1)=zytzy(ii,2)
-         zytzy(ii,jmar)=zytzy(ii,jmar-1)
-       ENDDO
-
-C  FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME.
-
-C  FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
-
-       zmea0(:,:) = zmea(:,:) ! GK211005 (CG) on sauvegarde la topo non lissee
-       CALL MVA9(zmea,iim+1,jjm+1)
-       CALL MVA9(zstd,iim+1,jjm+1)
-       CALL MVA9(zpic,iim+1,jjm+1)
-       CALL MVA9(zval,iim+1,jjm+1)
-       CALL MVA9(zxtzx,iim+1,jjm+1)
-       CALL MVA9(zxtzy,iim+1,jjm+1) 
-       CALL MVA9(zytzy,iim+1,jjm+1)
-Cx$$   Masque prenant en compte maximum de terre
-Cx$$  On seuil a 10% de terre de terre car en dessous les parametres de surface n'on
-Cx$$ pas de sens (PB)
-       mask_tmp= 0.0
-       WHERE(mask .GE. 0.1) mask_tmp = 1.
-
-       DO ii = 1, imar
-       DO jj = 1, jmar
-         IF (weight(ii,jj) .NE. 0.0) THEN
-c  Coefficients K, L et M:
-           xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
-           xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
-           xm=zxtzy(ii,jj)
-           xp=xk-sqrt(xl**2+xm**2)
-           xq=xk+sqrt(xl**2+xm**2)
-           xw=1.e-8
-           if(xp.le.xw) xp=0.
-           if(xq.le.xw) xq=xw
-           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
-c slope: 
-cx$$           zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
-cx$$c isotropy:
-cx$$           zgam(ii,jj)=xp/xq*mask(ii,jj)
-cx$$c angle theta:
-cx$$           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
-cx$$           zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
-cx$$           zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
-cx$$           zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
-cx$$           zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
-cx$$           zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
-Cx$* PB modif pour maque de terre fractionnaire
-c slope: 
-           zsig(ii,jj)=sqrt(xq)*mask_tmp(ii,jj)
-c isotropy:
-           zgam(ii,jj)=xp/xq*mask_tmp(ii,jj)
-c angle theta:
-           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask_tmp(ii,jj)
-           ! GK211005 (CG) ne pas forcement lisser la topo
-           ! zphi(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
-           zphi(ii,jj)=zmea0(ii,jj)*mask_tmp(ii,jj)
-           !
-           zmea(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
-           zpic(ii,jj)=zpic(ii,jj)*mask_tmp(ii,jj)
-           zval(ii,jj)=zval(ii,jj)*mask_tmp(ii,jj)
-           zstd(ii,jj)=zstd(ii,jj)*mask_tmp(ii,jj)
-c          print 101,ii,jj,
-c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
-c    *           zthe(ii,jj)
-c101  format(1x,2(1x,i2),2(1x,f7.1),1x,f7.4,2x,f4.2,1x,f5.1)     
-         ELSE
-c           PRINT*, 'probleme,ii,jj=', ii,jj
-         ENDIF
-      zllmmea=AMAX1(zmea(ii,jj),zllmmea)
-      zllmstd=AMAX1(zstd(ii,jj),zllmstd)
-      zllmsig=AMAX1(zsig(ii,jj),zllmsig)
-      zllmgam=AMAX1(zgam(ii,jj),zllmgam)
-      zllmthe=AMAX1(zthe(ii,jj),zllmthe)
-      zminthe=amin1(zthe(ii,jj),zminthe)
-      zllmpic=AMAX1(zpic(ii,jj),zllmpic)
-      zllmval=AMAX1(zval(ii,jj),zllmval)
-       ENDDO
-       ENDDO
-      print *,'  MEAN ORO:',zllmmea
-      print *,'  ST. DEV.:',zllmstd
-      print *,'  PENTE:',zllmsig
-      print *,' ANISOTROP:',zllmgam
-      print *,'  ANGLE:',zminthe,zllmthe	
-      print *,'  pic:',zllmpic
-      print *,'  val:',zllmval
-      
-C
-c gamma and theta a 1. and 0. at poles
-c
-      DO jj=1,jmar
-      zmea(imar+1,jj)=zmea(1,jj)
-      zphi(imar+1,jj)=zphi(1,jj)
-      zpic(imar+1,jj)=zpic(1,jj)
-      zval(imar+1,jj)=zval(1,jj)
-      zstd(imar+1,jj)=zstd(1,jj)
-      zsig(imar+1,jj)=zsig(1,jj)
-      zgam(imar+1,jj)=zgam(1,jj)
-      zthe(imar+1,jj)=zthe(1,jj)
-      ENDDO
-
-
-      zmeanor=0.0
-      zmeasud=0.0
-      zstdnor=0.0
-      zstdsud=0.0
-      zsignor=0.0
-      zsigsud=0.0
-      zweinor=0.0
-      zweisud=0.0
-      zpicnor=0.0
-      zpicsud=0.0                                   
-      zvalnor=0.0
-      zvalsud=0.0 
-
-      DO ii=1,imar
-      zweinor=zweinor+              weight(ii,   1)
-      zweisud=zweisud+              weight(ii,jmar)
-      zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)
-      zmeasud=zmeasud+zmea(ii,jmar)*weight(ii,jmar)
-      zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)
-      zstdsud=zstdsud+zstd(ii,jmar)*weight(ii,jmar)
-      zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)
-      zsigsud=zsigsud+zsig(ii,jmar)*weight(ii,jmar)
-      zpicnor=zpicnor+zpic(ii,   1)*weight(ii,   1)
-      zpicsud=zpicsud+zpic(ii,jmar)*weight(ii,jmar)
-      zvalnor=zvalnor+zval(ii,   1)*weight(ii,   1)
-      zvalsud=zvalsud+zval(ii,jmar)*weight(ii,jmar)
-      ENDDO
-
-      DO ii=1,imar+1
-      zmea(ii,   1)=zmeanor/zweinor
-      zmea(ii,jmar)=zmeasud/zweisud
-      zphi(ii,   1)=zmeanor/zweinor
-      zphi(ii,jmar)=zmeasud/zweisud
-      zpic(ii,   1)=zpicnor/zweinor
-      zpic(ii,jmar)=zpicsud/zweisud
-      zval(ii,   1)=zvalnor/zweinor
-      zval(ii,jmar)=zvalsud/zweisud
-      zstd(ii,   1)=zstdnor/zweinor
-      zstd(ii,jmar)=zstdsud/zweisud
-      zsig(ii,   1)=zsignor/zweinor
-      zsig(ii,jmar)=zsigsud/zweisud
-      zgam(ii,   1)=1.
-      zgam(ii,jmar)=1.
-      zthe(ii,   1)=0.
-      zthe(ii,jmar)=0.
-      ENDDO
-
-      RETURN
-      END
-
-      SUBROUTINE MVA9(X,IMAR,JMAR)
-
-C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
-
-      REAL X(IMAR,JMAR),XF(IMAR,JMAR)
-      real WEIGHTpb(-1:1,-1:1)
-
-
-      SUM=0.
-      DO IS=-1,1
-        DO JS=-1,1
-          WEIGHTpb(IS,JS)=1./REAL((1+IS**2)*(1+JS**2))
-          SUM=SUM+WEIGHTpb(IS,JS)
-        ENDDO
-      ENDDO
-      
-c     WRITE(*,*) 'MVA9 ', IMAR, JMAR
-c     WRITE(*,*) 'MVA9 ', WEIGHTpb
-c     WRITE(*,*) 'MVA9 SUM ', SUM
-      DO IS=-1,1
-        DO JS=-1,1
-          WEIGHTpb(IS,JS)=WEIGHTpb(IS,JS)/SUM
-        ENDDO
-      ENDDO
-
-      DO J=2,JMAR-1
-        DO I=2,IMAR-1
-          XF(I,J)=0.
-          DO IS=-1,1
-            DO JS=-1,1
-              XF(I,J)=XF(I,J)+X(I+IS,J+JS)*WEIGHTpb(IS,JS)
-            ENDDO
-          ENDDO
-        ENDDO
-      ENDDO
-
-      DO J=2,JMAR-1
-        XF(1,J)=0.
-        IS=IMAR-1
-        DO JS=-1,1 
-          XF(1,J)=XF(1,J)+X(IS,J+JS)*WEIGHTpb(-1,JS)
-        ENDDO
-        DO IS=0,1 
-          DO JS=-1,1 
-            XF(1,J)=XF(1,J)+X(1+IS,J+JS)*WEIGHTpb(IS,JS)
-          ENDDO
-        ENDDO
-        XF(IMAR,J)=XF(1,J)
-      ENDDO
-
-      DO I=1,IMAR
-        XF(I,1)=XF(I,2)
-        XF(I,JMAR)=XF(I,JMAR-1)
-      ENDDO
-
-      DO I=1,IMAR
-        DO J=1,JMAR
-          X(I,J)=XF(I,J)
-        ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
Index: LMDZ5/trunk/libf/dyn3d/juldate.F
===================================================================
--- LMDZ5/trunk/libf/dyn3d/juldate.F	(revision 1943)
+++ 	(revision )
@@ -1,33 +1,0 @@
-!
-! $Id$
-!
-	subroutine juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec)
-c	Sous-routine de changement de date:
-c	gregorien>>>date julienne
-c	En entree:an,mois,jour,heure,min.,sec.
-c	En sortie:tjd
-	implicit real (a-h,o-z)
-	frac=((os/60.+om)/60.+oh)/24.
-	ojou=dble(ijou)+frac
-	    year=dble(ian)
-	    rmon=dble(imoi)
-	if (imoi .le. 2) then
-	    year=year-1.
-	    rmon=rmon+12.
-	endif
-	cf=year+(rmon/100.)+(ojou/10000.)
-	if (cf .ge. 1582.1015) then
-	    a=int(year/100)
-	    b=2-a+int(a/4)
-	else
-	    b=0
-	endif
-	tjd=int(365.25*year)+int(30.6001*(rmon+1))+int(ojou)
-     +   +1720994.5+b
-        tjdsec=(ojou-int(ojou))+(tjd-int(tjd))
-        tjd=int(tjd)+int(tjdsec)
-	tjdsec=tjdsec-int(tjdsec)
-	return
-	end
-
-
Index: LMDZ5/trunk/libf/dyn3d/pres2lev_mod.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3d/pres2lev_mod.F90	(revision 1943)
+++ 	(revision )
@@ -1,79 +1,0 @@
-! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $
-!
-MODULE pres2lev_mod
-
-CONTAINS 
-
-!******************************************************
-SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn,ni,nj,ok_invertp)
-!
-! interpolation lineaire pour passer
-! a une nouvelle discretisation verticale pour
-! les variables de GCM
-! Francois Forget (01/1995)
-! MOdif remy roca 12/97 pour passer de pres2sig
-! Modif F.Codron 07/08 po en 3D
-!**********************************************************
-
-  IMPLICIT NONE
-
-!   Declarations:
-! ==============
-!
-!  ARGUMENTS
-!  """""""""
-  LOGICAL, INTENT(IN) :: ok_invertp
-  INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
-  INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
-  
-  INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
-  REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille
-  REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille
-
-  REAL, INTENT(IN)  :: varo(ni*nj,lmo) ! var dans l'ancienne grille
-  REAL, INTENT(OUT) :: varn(ni*nj,lmn) ! var dans la nouvelle grille
-
-  REAL :: zvaro(ni*nj,lmo),zpo(ni*nj,lmo)
-
-! Autres variables
-! """"""""""""""""
-  INTEGER ::  ln ,lo, k
-  REAL    :: coef
-
-
-! Inversion de l'ordre des niveaux verticaux
-  IF (ok_invertp) THEN
-    DO lo=1,lmo
-      DO k=1,ni*nj
-        zpo(k,lo)=po(k,lmo+1-lo)
-        zvaro(k,lo)=varo(k,lmo+1-lo)
-      ENDDO
-    ENDDO
-  ELSE
-    DO lo=1,lmo
-      DO k=1,ni*nj
-        zpo(k,lo)=po(k,lo)
-        zvaro(k,lo)=varo(k,lo)
-      ENDDO
-    ENDDO
-  ENDIF 
-
-  DO ln=1,lmn
-    DO lo=1,lmo-1
-      DO k=1,ni*nj
-        IF (pn(k,ln) >= zpo(k,1) ) THEN
-          varn(k,ln) = zvaro(k,1)
-        ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN
-          varn(k,ln) = zvaro(k,lmo)
-        ELSE IF ( pn(k,ln) <= zpo(k,lo) .AND. pn(k,ln) > zpo(k,lo+1) ) THEN
-          coef = (pn(k,ln)-zpo(k,lo)) / (zpo(k,lo+1)-zpo(k,lo))
-          varn(k,ln) = zvaro(k,lo) + coef*(zvaro(k,lo+1)-zvaro(k,lo))
-        ENDIF
-         
-      ENDDO  
-    ENDDO
-  ENDDO                
-
-END SUBROUTINE pres2lev    
-
-END MODULE pres2lev_mod
Index: LMDZ5/trunk/libf/dyn3d/ran1.F
===================================================================
--- LMDZ5/trunk/libf/dyn3d/ran1.F	(revision 1943)
+++ 	(revision )
@@ -1,34 +1,0 @@
-!
-! $Id$
-!
-      FUNCTION RAN1(IDUM)
-      DIMENSION R(97)
-      save r
-      save iff,ix1,ix2,ix3
-      PARAMETER (M1=259200,IA1=7141,IC1=54773,RM1=3.8580247E-6)
-      PARAMETER (M2=134456,IA2=8121,IC2=28411,RM2=7.4373773E-6)
-      PARAMETER (M3=243000,IA3=4561,IC3=51349)
-      DATA IFF /0/
-      IF (IDUM.LT.0.OR.IFF.EQ.0) THEN
-        IFF=1
-        IX1=MOD(IC1-IDUM,M1)
-        IX1=MOD(IA1*IX1+IC1,M1)
-        IX2=MOD(IX1,M2)
-        IX1=MOD(IA1*IX1+IC1,M1)
-        IX3=MOD(IX1,M3)
-        DO 11 J=1,97
-          IX1=MOD(IA1*IX1+IC1,M1)
-          IX2=MOD(IA2*IX2+IC2,M2)
-          R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
-11      CONTINUE
-        IDUM=1
-      ENDIF
-      IX1=MOD(IA1*IX1+IC1,M1)
-      IX2=MOD(IA2*IX2+IC2,M2)
-      IX3=MOD(IA3*IX3+IC3,M3)
-      J=1+(97*IX3)/M3
-      IF(J.GT.97.OR.J.LT.1) stop 1
-      RAN1=R(J)
-      R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3d_common/defrun.F
===================================================================
--- LMDZ5/trunk/libf/dyn3d_common/defrun.F	(revision 1944)
+++ LMDZ5/trunk/libf/dyn3d_common/defrun.F	(revision 1944)
@@ -0,0 +1,496 @@
+!
+! $Id$
+!
+c
+c
+      SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
+c
+      USE control_mod
+ 
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c     Auteurs :   L. Fairhead , P. Le Van  .
+c
+c     Arguments :
+c
+c     tapedef   :
+c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
+c     -metres  du zoom  avec  celles lues sur le fichier start .
+c      clesphy0 :  sortie  .
+c
+       LOGICAL etatinit
+       INTEGER tapedef
+
+       INTEGER        longcles
+       PARAMETER(     longcles = 20 )
+       REAL clesphy0( longcles )
+c
+c   Declarations :
+c   --------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "serre.h"
+#include "comdissnew.h"
+#include "clesph0.h"
+c
+c
+c   local:
+c   ------
+
+      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
+      INTEGER   tapeout
+      REAL clonn,clatt,grossismxx,grossismyy
+      REAL dzoomxx,dzoomyy,tauxx,tauyy
+      LOGICAL  fxyhypbb, ysinuss
+      INTEGER i
+      
+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 de tapedef : ** 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  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  grossismx ,
+c    grossismy,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( tapedef,file ='gcm.def',status='old',form='formatted')
+
+
+      READ (tapedef,9000) ch1,ch2,ch3
+      WRITE(tapeout,9000) ch1,ch2,ch3
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    dayref
+      WRITE(tapeout,9001) ch1,'dayref'
+      WRITE(tapeout,*)    dayref
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    anneeref
+      WRITE(tapeout,9001) ch1,'anneeref'
+      WRITE(tapeout,*)    anneeref
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    nday
+      WRITE(tapeout,9001) ch1,'nday'
+      WRITE(tapeout,*)    nday
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    day_step
+      WRITE(tapeout,9001) ch1,'day_step'
+      WRITE(tapeout,*)    day_step
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    iperiod
+      WRITE(tapeout,9001) ch1,'iperiod'
+      WRITE(tapeout,*)    iperiod
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    iapp_tracvl
+      WRITE(tapeout,9001) ch1,'iapp_tracvl'
+      WRITE(tapeout,*)    iapp_tracvl
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    iconser
+      WRITE(tapeout,9001) ch1,'iconser'
+      WRITE(tapeout,*)    iconser
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    iecri
+      WRITE(tapeout,9001) ch1,'iecri'
+      WRITE(tapeout,*)    iecri
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    periodav
+      WRITE(tapeout,9001) ch1,'periodav'
+      WRITE(tapeout,*)    periodav
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    dissip_period
+      WRITE(tapeout,9001) ch1,'dissip_period'
+      WRITE(tapeout,*)    dissip_period
+
+ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
+ccc
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    lstardis
+      WRITE(tapeout,9001) ch1,'lstardis'
+      WRITE(tapeout,*)    lstardis
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    nitergdiv
+      WRITE(tapeout,9001) ch1,'nitergdiv'
+      WRITE(tapeout,*)    nitergdiv
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    nitergrot
+      WRITE(tapeout,9001) ch1,'nitergrot'
+      WRITE(tapeout,*)    nitergrot
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    niterh
+      WRITE(tapeout,9001) ch1,'niterh'
+      WRITE(tapeout,*)    niterh
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    tetagdiv
+      WRITE(tapeout,9001) ch1,'tetagdiv'
+      WRITE(tapeout,*)    tetagdiv
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    tetagrot
+      WRITE(tapeout,9001) ch1,'tetagrot'
+      WRITE(tapeout,*)    tetagrot
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    tetatemp
+      WRITE(tapeout,9001) ch1,'tetatemp'
+      WRITE(tapeout,*)    tetatemp
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    coefdis
+      WRITE(tapeout,9001) ch1,'coefdis'
+      WRITE(tapeout,*)    coefdis
+c
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    purmats
+      WRITE(tapeout,9001) ch1,'purmats'
+      WRITE(tapeout,*)    purmats
+
+c    ...............................................................
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    iflag_phys
+      WRITE(tapeout,9001) ch1,'iflag_phys'
+      WRITE(tapeout,*)    iflag_phys
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    iphysiq
+      WRITE(tapeout,9001) ch1,'iphysiq'
+      WRITE(tapeout,*)    iphysiq
+
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    cycle_diurne
+      WRITE(tapeout,9001) ch1,'cycle_diurne'
+      WRITE(tapeout,*)    cycle_diurne
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    soil_model
+      WRITE(tapeout,9001) ch1,'soil_model'
+      WRITE(tapeout,*)    soil_model
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    new_oliq
+      WRITE(tapeout,9001) ch1,'new_oliq'
+      WRITE(tapeout,*)    new_oliq
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    ok_orodr
+      WRITE(tapeout,9001) ch1,'ok_orodr'
+      WRITE(tapeout,*)    ok_orodr
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    ok_orolf
+      WRITE(tapeout,9001) ch1,'ok_orolf'
+      WRITE(tapeout,*)    ok_orolf
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    ok_limitvrai
+      WRITE(tapeout,9001) ch1,'ok_limitvrai'
+      WRITE(tapeout,*)    ok_limitvrai
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    nbapp_rad
+      WRITE(tapeout,9001) ch1,'nbapp_rad'
+      WRITE(tapeout,*)    nbapp_rad
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    iflag_con
+      WRITE(tapeout,9001) ch1,'iflag_con'
+      WRITE(tapeout,*)    iflag_con
+
+      DO i = 1, longcles
+       clesphy0(i) = 0.
+      ENDDO
+                          clesphy0(1) = REAL( iflag_con )
+                          clesphy0(2) = REAL( nbapp_rad )
+
+       IF( cycle_diurne  ) clesphy0(3) =  1.
+       IF(   soil_model  ) clesphy0(4) =  1.
+       IF(     new_oliq  ) clesphy0(5) =  1.
+       IF(     ok_orodr  ) clesphy0(6) =  1.
+       IF(     ok_orolf  ) clesphy0(7) =  1.
+       IF(  ok_limitvrai ) clesphy0(8) =  1.
+
+
+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 (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    clonn
+      WRITE(tapeout,9001) ch1,'clon'
+      WRITE(tapeout,*)    clonn
+      IF( ABS(clon - clonn).GE. 0.001 )  THEN
+       WRITE(tapeout,*) ' La valeur de clon passee par run.def est diffe
+     *rente de  celle lue sur le fichier  start '
+        STOP
+      ENDIF
+c
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    clatt
+      WRITE(tapeout,9001) ch1,'clat'
+      WRITE(tapeout,*)    clatt
+
+      IF( ABS(clat - clatt).GE. 0.001 )  THEN
+       WRITE(tapeout,*) ' La valeur de clat passee par run.def est diffe
+     *rente de  celle lue sur le fichier  start '
+        STOP
+      ENDIF
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    grossismxx
+      WRITE(tapeout,9001) ch1,'grossismx'
+      WRITE(tapeout,*)    grossismxx
+
+      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
+       WRITE(tapeout,*) ' La valeur de grossismx passee par run.def est
+     , differente de celle lue sur le fichier  start '
+        STOP
+      ENDIF
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    grossismyy
+      WRITE(tapeout,9001) ch1,'grossismy'
+      WRITE(tapeout,*)    grossismyy
+
+      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
+       WRITE(tapeout,*) ' La valeur de grossismy passee par run.def est
+     , differente de celle lue sur le fichier  start '
+        STOP
+      ENDIF
+      
+      IF( grossismx.LT.1. )  THEN
+        WRITE(tapeout,*) ' ***  ATTENTION !! grossismx < 1 .   *** '
+         STOP
+      ELSE
+         alphax = 1. - 1./ grossismx
+      ENDIF
+
+
+      IF( grossismy.LT.1. )  THEN
+        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
+         STOP
+      ELSE
+         alphay = 1. - 1./ grossismy
+      ENDIF
+
+c
+c    alphax et alphay sont les anciennes formulat. des grossissements
+c
+c
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    fxyhypbb
+      WRITE(tapeout,9001) ch1,'fxyhypbb'
+      WRITE(tapeout,*)    fxyhypbb
+
+      IF( .NOT.fxyhypb )  THEN
+           IF( fxyhypbb )     THEN
+            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
+            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est F'
+     *,      '                   alors  qu il est  T  sur  run.def  ***'
+              STOP
+           ENDIF
+      ELSE
+           IF( .NOT.fxyhypbb )   THEN
+            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
+            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est t'
+     *,      '                   alors  qu il est  F  sur  run.def  ***'
+              STOP
+           ENDIF
+      ENDIF
+c
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    dzoomxx
+      WRITE(tapeout,9001) ch1,'dzoomx'
+      WRITE(tapeout,*)    dzoomxx
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    dzoomyy
+      WRITE(tapeout,9001) ch1,'dzoomy'
+      WRITE(tapeout,*)    dzoomyy
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    tauxx
+      WRITE(tapeout,9001) ch1,'taux'
+      WRITE(tapeout,*)    tauxx
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    tauyy
+      WRITE(tapeout,9001) ch1,'tauy'
+      WRITE(tapeout,*)    tauyy
+
+      IF( fxyhypb )  THEN
+
+       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
+        WRITE(tapeout,*)' La valeur de dzoomx passee par run.def est dif
+     *ferente de celle lue sur le fichier  start '
+        CALL ABORT_gcm("defrun", "", 1)
+       ENDIF
+
+       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
+        WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
+     *ferente de celle lue sur le fichier  start '
+        CALL ABORT_gcm("defrun", "", 1)
+       ENDIF
+
+       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
+        WRITE(6,*)' La valeur de taux passee par run.def est differente
+     *  de celle lue sur le fichier  start '
+        CALL ABORT_gcm("defrun", "", 1)
+       ENDIF
+
+       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
+        WRITE(6,*)' La valeur de tauy passee par run.def est differente
+     *  de celle lue sur le fichier  start '
+        CALL ABORT_gcm("defrun", "", 1)
+       ENDIF
+
+      ENDIF
+      
+cc
+      IF( .NOT.fxyhypb  )  THEN
+        READ (tapedef,9001) ch1,ch4
+        READ (tapedef,*)    ysinuss
+        WRITE(tapeout,9001) ch1,'ysinus'
+        WRITE(tapeout,*)    ysinuss
+
+
+        IF( .NOT.ysinus )  THEN
+           IF( ysinuss )     THEN
+              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
+              WRITE(tapeout,*)'** ysinus lu sur le fichier start est F',
+     *       ' alors  qu il est  T  sur  run.def  ***'
+              STOP
+           ENDIF
+        ELSE
+           IF( .NOT.ysinuss )   THEN
+              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
+              WRITE(tapeout,*)'** ysinus lu sur le fichier start est T',
+     *       ' alors  qu il est  F  sur  run.def  ***'
+              STOP
+           ENDIF
+        ENDIF
+      ENDIF
+c
+      WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
+
+      CLOSE(tapedef)
+
+      RETURN
+c   ...............................................
+c
+100   CONTINUE
+c
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    clon
+      WRITE(tapeout,9001) ch1,'clon'
+      WRITE(tapeout,*)    clon
+c
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    clat
+      WRITE(tapeout,9001) ch1,'clat'
+      WRITE(tapeout,*)    clat
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    grossismx
+      WRITE(tapeout,9001) ch1,'grossismx'
+      WRITE(tapeout,*)    grossismx
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    grossismy
+      WRITE(tapeout,9001) ch1,'grossismy'
+      WRITE(tapeout,*)    grossismy
+
+      IF( grossismx.LT.1. )  THEN
+        WRITE(tapeout,*) '***  ATTENTION !! grossismx < 1 .   *** '
+         STOP
+      ELSE
+         alphax = 1. - 1./ grossismx
+      ENDIF
+
+      IF( grossismy.LT.1. )  THEN
+        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
+         STOP
+      ELSE
+         alphay = 1. - 1./ grossismy
+      ENDIF
+
+c
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    fxyhypb
+      WRITE(tapeout,9001) ch1,'fxyhypb'
+      WRITE(tapeout,*)    fxyhypb
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    dzoomx
+      WRITE(tapeout,9001) ch1,'dzoomx'
+      WRITE(tapeout,*)    dzoomx
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    dzoomy
+      WRITE(tapeout,9001) ch1,'dzoomy'
+      WRITE(tapeout,*)    dzoomy
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    taux
+      WRITE(tapeout,9001) ch1,'taux'
+      WRITE(tapeout,*)    taux
+c
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    tauy
+      WRITE(tapeout,9001) ch1,'tauy'
+      WRITE(tapeout,*)    tauy
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    ysinus
+      WRITE(tapeout,9001) ch1,'ysinus'
+      WRITE(tapeout,*)    ysinus
+       
+      WRITE(tapeout,*) ' alphax alphay defrun ',alphax,alphay
+c
+9000  FORMAT(3(/,a72))
+9001  FORMAT(/,a72,/,a12)
+cc
+      CLOSE(tapedef)
+
+      RETURN
+      END
Index: LMDZ5/trunk/libf/dyn3d_common/fyhyp.F
===================================================================
--- LMDZ5/trunk/libf/dyn3d_common/fyhyp.F	(revision 1944)
+++ LMDZ5/trunk/libf/dyn3d_common/fyhyp.F	(revision 1944)
@@ -0,0 +1,378 @@
+!
+! $Id$
+!
+c
+c
+       SUBROUTINE fyhyp ( yzoomdeg, grossism, dzooma,tau  ,  
+     ,  rrlatu,yyprimu,rrlatv,yyprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
+     ,  champmin,champmax                                            ) 
+
+cc    ...  Version du 01/04/2001 ....
+
+       IMPLICIT NONE
+c
+c    ...   Auteur :  P. Le Van  ... 
+c
+c    .......    d'apres  formulations  de R. Sadourny  .......
+c
+c     Calcule les latitudes et derivees dans la grille du GCM pour une
+c     fonction f(y) a tangente  hyperbolique  .
+c
+c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois , etc)
+c     dzoom  etant  la distance totale de la zone du zoom ( en radians )
+c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom   
+c
+c
+c N.B : Il vaut mieux avoir : grossism * dzoom  <  pi/2  (radians) ,en lati.
+c      ********************************************************************
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+
+       INTEGER      nmax , nmax2
+       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
+c
+c
+c     .......  arguments  d'entree    .......
+c
+       REAL yzoomdeg, grossism,dzooma,tau 
+c         ( rentres  par  run.def )
+
+c     .......  arguments  de sortie   .......
+c
+       REAL rrlatu(jjp1), yyprimu(jjp1),rrlatv(jjm), yyprimv(jjm),
+     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
+
+c
+c     .....     champs  locaux    .....
+c
+     
+       REAL   dzoom
+       REAL(KIND=8) ylat(jjp1), yprim(jjp1)
+       REAL(KIND=8) yuv
+       REAL(KIND=8) yt(0:nmax2)
+       REAL(KIND=8) fhyp(0:nmax2),beta,Ytprim(0:nmax2),fxm(0:nmax2)
+       SAVE Ytprim, yt,Yf
+       REAL(KIND=8) Yf(0:nmax2),yypr(0:nmax2)
+       REAL(KIND=8) yvrai(jjp1), yprimm(jjp1),ylatt(jjp1)
+       REAL(KIND=8) pi,depi,pis2,epsilon,y0,pisjm
+       REAL(KIND=8) yo1,yi,ylon2,ymoy,Yprimin,champmin,champmax
+       REAL(KIND=8) yfi,Yf1,ffdy
+       REAL(KIND=8) ypn,deply,y00
+       SAVE y00, deply
+
+       INTEGER i,j,it,ik,iter,jlat
+       INTEGER jpn,jjpn
+       SAVE jpn
+       REAL(KIND=8) a0,a1,a2,a3,yi2,heavyy0,heavyy0m
+       REAL(KIND=8) fa(0:nmax2),fb(0:nmax2)
+       REAL y0min,y0max
+
+       REAL(KIND=8)     heavyside
+
+       pi       = 2. * ASIN(1.)
+       depi     = 2. * pi
+       pis2     = pi/2.
+       pisjm    = pi/ REAL(jjm)
+       epsilon  = 1.e-3
+       y0       =  yzoomdeg * pi/180. 
+
+       IF( dzooma.LT.1.)  THEN
+         dzoom = dzooma * pi
+       ELSEIF( dzooma.LT. 12. ) THEN
+         WRITE(6,*) ' Le param. dzoomy pour fyhyp est trop petit ! L aug
+     ,menter et relancer ! '
+         STOP 1
+       ELSE
+         dzoom = dzooma * pi/180.
+       ENDIF
+
+       WRITE(6,18)
+       WRITE(6,*) ' yzoom( rad.),grossism,tau,dzoom (radians)'
+       WRITE(6,24) y0,grossism,tau,dzoom
+
+       DO i = 0, nmax2 
+        yt(i) = - pis2  + REAL(i)* pi /nmax2
+       ENDDO
+
+       heavyy0m = heavyside( -y0 )
+       heavyy0  = heavyside(  y0 )
+       y0min    = 2.*y0*heavyy0m - pis2
+       y0max    = 2.*y0*heavyy0  + pis2
+
+       fa = 999.999
+       fb = 999.999
+       
+       DO i = 0, nmax2 
+        IF( yt(i).LT.y0 )  THEN
+         fa (i) = tau*  (yt(i)-y0+dzoom/2. )
+         fb(i) =   (yt(i)-2.*y0*heavyy0m +pis2) * ( y0 - yt(i) )
+        ELSEIF ( yt(i).GT.y0 )  THEN
+         fa(i) =   tau *(y0-yt(i)+dzoom/2. )
+         fb(i) = (2.*y0*heavyy0 -yt(i)+pis2) * ( yt(i) - y0 ) 
+       ENDIF
+        
+       IF( 200.* fb(i) .LT. - fa(i) )   THEN
+         fhyp ( i) = - 1.
+       ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
+         fhyp ( i) =   1.
+       ELSE  
+         fhyp(i) =  TANH ( fa(i)/fb(i) )
+       ENDIF
+
+       IF( yt(i).EQ.y0 )  fhyp(i) = 1.
+       IF(yt(i).EQ. y0min. OR.yt(i).EQ. y0max ) fhyp(i) = -1.
+
+       ENDDO
+
+cc  ....  Calcul  de  beta  ....
+c
+       ffdy   = 0.
+
+       DO i = 1, nmax2
+        ymoy    = 0.5 * ( yt(i-1) + yt( i ) )
+        IF( ymoy.LT.y0 )  THEN
+         fa(i)= tau * ( ymoy-y0+dzoom/2.) 
+         fb(i) = (ymoy-2.*y0*heavyy0m +pis2) * ( y0 - ymoy )
+        ELSEIF ( ymoy.GT.y0 )  THEN
+         fa(i)= tau * ( y0-ymoy+dzoom/2. ) 
+         fb(i) = (2.*y0*heavyy0 -ymoy+pis2) * ( ymoy - y0 )
+        ENDIF
+
+        IF( 200.* fb(i) .LT. - fa(i) )    THEN
+         fxm ( i) = - 1.
+        ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
+         fxm ( i) =   1.
+        ELSE
+         fxm(i) =  TANH ( fa(i)/fb(i) )
+        ENDIF
+         IF( ymoy.EQ.y0 )  fxm(i) = 1.
+         IF (ymoy.EQ. y0min. OR.yt(i).EQ. y0max ) fxm(i) = -1.
+         ffdy = ffdy + fxm(i) * ( yt(i) - yt(i-1) )
+
+        ENDDO
+
+        beta  = ( grossism * ffdy - pi ) / ( ffdy - pi )
+
+       IF( 2.*beta - grossism.LE. 0.)  THEN
+
+        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
+     ,tine fyhyp est mauvaise ! '
+        WRITE(6,*)'Modifier les valeurs de  grossismy ,tauy ou dzoomy',
+     , ' et relancer ! ***  '
+        CALL ABORT_GCM("FYHYP", "", 1)
+
+       ENDIF
+c
+c   .....  calcul  de  Ytprim   .....
+c
+       
+       DO i = 0, nmax2
+        Ytprim(i) = beta  + ( grossism - beta ) * fhyp(i)
+       ENDDO
+
+c   .....  Calcul  de  Yf     ........
+
+       Yf(0) = - pis2
+       DO i = 1, nmax2
+        yypr(i)    = beta + ( grossism - beta ) * fxm(i)
+       ENDDO
+
+       DO i=1,nmax2
+        Yf(i)   = Yf(i-1) + yypr(i) * ( yt(i) - yt(i-1) )
+       ENDDO
+
+c    ****************************************************************
+c
+c   .....   yuv  = 0.   si calcul des latitudes  aux pts.  U  .....
+c   .....   yuv  = 0.5  si calcul des latitudes  aux pts.  V  .....
+c
+      WRITE(6,18)
+c
+      DO 5000  ik = 1,4
+
+       IF( ik.EQ.1 )  THEN
+         yuv  = 0.
+         jlat = jjm + 1
+       ELSE IF ( ik.EQ.2 )  THEN
+         yuv  = 0.5
+         jlat = jjm 
+       ELSE IF ( ik.EQ.3 )  THEN
+         yuv  = 0.25
+         jlat = jjm 
+       ELSE IF ( ik.EQ.4 )  THEN
+         yuv  = 0.75
+         jlat = jjm 
+       ENDIF
+c
+       yo1   = 0.
+       DO 1500 j =  1,jlat
+        yo1   = 0.
+        ylon2 =  - pis2 + pisjm * ( REAL(j)  + yuv  -1.)  
+        yfi    = ylon2
+c
+       DO 250 it =  nmax2,0,-1
+        IF( yfi.GE.Yf(it))  GO TO 350
+250    CONTINUE
+       it = 0
+350    CONTINUE
+
+       yi = yt(it)
+       IF(it.EQ.nmax2)  THEN
+        it       = nmax2 -1
+        Yf(it+1) = pis2
+       ENDIF
+c  .................................................................
+c  ....  Interpolation entre  yi(it) et yi(it+1)   pour avoir Y(yi)  
+c      .....           et   Y'(yi)                             .....
+c  .................................................................
+
+       CALL coefpoly ( Yf(it),Yf(it+1),Ytprim(it), Ytprim(it+1),   
+     ,                  yt(it),yt(it+1) ,   a0,a1,a2,a3   )      
+
+       Yf1     = Yf(it)
+       Yprimin = a1 + 2.* a2 * yi + 3.*a3 * yi *yi
+
+       DO 500 iter = 1,300
+         yi = yi - ( Yf1 - yfi )/ Yprimin
+
+        IF( ABS(yi-yo1).LE.epsilon)  GO TO 550
+         yo1      = yi
+         yi2      = yi * yi
+         Yf1      = a0 +  a1 * yi +     a2 * yi2  +     a3 * yi2 * yi
+         Yprimin  =       a1      + 2.* a2 *  yi  + 3.* a3 * yi2
+500   CONTINUE
+        WRITE(6,*) ' Pas de solution ***** ',j,ylon2,iter
+         STOP 2
+550   CONTINUE
+c
+       Yprimin   = a1  + 2.* a2 *  yi   + 3.* a3 * yi* yi
+       yprim(j)  = pi / ( jjm * Yprimin )
+       yvrai(j)  = yi 
+
+1500    CONTINUE
+
+       DO j = 1, jlat -1
+        IF( yvrai(j+1). LT. yvrai(j) )  THEN
+         WRITE(6,*) ' PBS. avec  rlat(',j+1,') plus petit que rlat(',j,
+     ,  ')'
+         STOP 3
+        ENDIF
+       ENDDO
+
+       WRITE(6,*) 'Reorganisation des latitudes pour avoir entre - pi/2'
+     , ,' et  pi/2 '
+c
+        IF( ik.EQ.1 )   THEN
+           ypn = pis2 
+          DO j = jlat,1,-1
+           IF( yvrai(j).LE. ypn ) GO TO 1502
+          ENDDO
+1502     CONTINUE
+
+         jpn   = j
+         y00   = yvrai(jpn)
+         deply = pis2 -  y00
+        ENDIF
+
+         DO  j = 1, jjm +1 - jpn
+           ylatt (j)  = -pis2 - y00  + yvrai(jpn+j-1)
+           yprimm(j)  = yprim(jpn+j-1)
+         ENDDO
+
+         jjpn  = jpn
+         IF( jlat.EQ. jjm ) jjpn = jpn -1
+
+         DO j = 1,jjpn 
+          ylatt (j + jjm+1 -jpn) = yvrai(j) + deply
+          yprimm(j + jjm+1 -jpn) = yprim(j)
+         ENDDO
+
+c      ***********   Fin de la reorganisation     *************
+c
+ 1600   CONTINUE
+
+       DO j = 1, jlat
+          ylat(j) =  ylatt( jlat +1 -j )
+         yprim(j) = yprimm( jlat +1 -j )
+       ENDDO
+  
+        DO j = 1, jlat
+         yvrai(j) = ylat(j)*180./pi
+        ENDDO
+
+        IF( ik.EQ.1 )  THEN
+c         WRITE(6,18) 
+c         WRITE(6,*)  ' YLAT  en U   apres ( en  deg. ) '
+c         WRITE(6,68) (yvrai(j),j=1,jlat)
+cc         WRITE(6,*) ' YPRIM '
+cc         WRITE(6,445) ( yprim(j),j=1,jlat)
+
+          DO j = 1, jlat
+            rrlatu(j) =  ylat( j )
+           yyprimu(j) = yprim( j )
+          ENDDO
+
+        ELSE IF ( ik.EQ. 2 )  THEN
+c         WRITE(6,18) 
+c         WRITE(6,*) ' YLAT   en V  apres ( en  deg. ) '
+c         WRITE(6,68) (yvrai(j),j=1,jlat)
+cc         WRITE(6,*)' YPRIM '
+cc         WRITE(6,445) ( yprim(j),j=1,jlat)
+
+          DO j = 1, jlat
+            rrlatv(j) =  ylat( j )
+           yyprimv(j) = yprim( j )
+          ENDDO
+
+        ELSE IF ( ik.EQ. 3 )  THEN
+c         WRITE(6,18) 
+c         WRITE(6,*)  ' YLAT  en U + 0.75  apres ( en  deg. ) '
+c         WRITE(6,68) (yvrai(j),j=1,jlat)
+cc         WRITE(6,*) ' YPRIM '
+cc         WRITE(6,445) ( yprim(j),j=1,jlat)
+
+          DO j = 1, jlat
+            rlatu2(j) =  ylat( j )
+           yprimu2(j) = yprim( j )
+          ENDDO
+
+        ELSE IF ( ik.EQ. 4 )  THEN
+c         WRITE(6,18) 
+c         WRITE(6,*)  ' YLAT en U + 0.25  apres ( en  deg. ) '
+c         WRITE(6,68)(yvrai(j),j=1,jlat)
+cc         WRITE(6,*) ' YPRIM '
+cc         WRITE(6,68) ( yprim(j),j=1,jlat)
+
+          DO j = 1, jlat
+            rlatu1(j) =  ylat( j )
+           yprimu1(j) = yprim( j )
+          ENDDO
+
+        ENDIF
+
+5000   CONTINUE
+c
+        WRITE(6,18)
+c
+c  .....     fin de la boucle  do 5000 .....
+
+        DO j = 1, jjm
+         ylat(j) = rrlatu(j) - rrlatu(j+1)
+        ENDDO
+        champmin =  1.e12
+        champmax = -1.e12
+        DO j = 1, jjm
+         champmin = MIN( champmin, ylat(j) )
+         champmax = MAX( champmax, ylat(j) )
+        ENDDO
+         champmin = champmin * 180./pi
+         champmax = champmax * 180./pi
+
+24     FORMAT(2x,'Parametres yzoom,gross,tau ,dzoom pour fyhyp ',4f8.3)
+18      FORMAT(/)
+68      FORMAT(1x,7f9.2)
+
+        RETURN
+        END
Index: LMDZ5/trunk/libf/dyn3d_common/grid_atob.F
===================================================================
--- LMDZ5/trunk/libf/dyn3d_common/grid_atob.F	(revision 1944)
+++ LMDZ5/trunk/libf/dyn3d_common/grid_atob.F	(revision 1944)
@@ -0,0 +1,971 @@
+!
+! $Id$
+!
+      SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree,
+     .                    imar, jmar, x, y, sortie)
+c=======================================================================
+c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
+c
+c Methode naive pour transformer un champ d'une grille fine a une
+c grille grossiere. Je considere que les nouveaux points occupent
+c une zone adjacente qui comprend un ou plusieurs anciens points
+c
+c Aucune ponderation est consideree (voir grille_p)
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X et Y pour depart
+c        xdata, ydata: coordonnees X et Y pour depart
+c        entree: champ d'entree a transformer
+c OUTPUT:
+c        imar, jmar: dimensions X et Y d'arrivee
+c        x, y: coordonnees X et Y d'arrivee
+c        sortie: champ de sortie deja transforme
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL sortie(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(2200),b(2200),c(1100),d(1100)
+      REAL number(2200,1100)
+      REAL distans(2200*1100)
+      INTEGER i_proche, j_proche, ij_proche
+#ifdef CRAY
+      INTEGER ISMIN
+#else
+      REAL zzmin
+#endif
+c
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT_GCM("", "", 1)
+      ENDIF
+c
+c Calculer les limites des zones des nouveaux points
+c
+
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         number(i,j) = 0.0
+         sortie(i,j) = 0.0
+      ENDDO
+      ENDDO
+c
+c Determiner la zone sur laquelle chaque ancien point se trouve
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+               number(ii,jj) = number(ii,jj) + 1.0
+               sortie(ii,jj) = sortie(ii,jj) + entree(i,j)
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c Si aucun ancien point tombe sur une zone, c'est un probleme
+c
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         IF (number(i,j) .GT. 0.001) THEN
+         sortie(i,j) = sortie(i,j) / number(i,j)
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+ccc         CALL ABORT_GCM("", "", 1)
+         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
+#ifdef CRAY
+         ij_proche = ISMIN(imdep*jmdep,distans,1)
+#else
+         ij_proche = 1
+         zzmin = distans(ij_proche)
+         DO ii = 2, imdep*jmdep
+            IF (distans(ii).LT.zzmin) THEN
+               zzmin = distans(ii)
+               ij_proche = ii
+            ENDIF
+         ENDDO
+#endif
+         j_proche = (ij_proche-1)/imdep + 1
+         i_proche = ij_proche - (j_proche-1)*imdep
+         PRINT*, "solution:", ij_proche, i_proche, j_proche
+         sortie(i,j) = entree(i_proche,j_proche)
+         ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+      SUBROUTINE grille_p(imdep, jmdep, xdata, ydata, entree,
+     .                    imar, jmar, x, y, sortie)
+c=======================================================================
+c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
+c
+c Methode naive pour transformer un champ d'une grille fine a une
+c grille grossiere. Je considere que les nouveaux points occupent
+c une zone adjacente qui comprend un ou plusieurs anciens points
+c
+c Consideration de la distance des points (voir grille_m)
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X et Y pour depart
+c        xdata, ydata: coordonnees X et Y pour depart
+c        entree: champ d'entree a transformer
+c OUTPUT:
+c        imar, jmar: dimensions X et Y d'arrivee
+c        x, y: coordonnees X et Y d'arrivee
+c        sortie: champ de sortie deja transforme
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL sortie(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(400),b(400),c(200),d(200)
+      REAL number(400,200)
+      INTEGER indx(400,200), indy(400,200)
+      REAL dist(400,200), distsom(400,200)
+c
+      IF (imar.GT.400 .OR. jmar.GT.200) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT_GCM("", "", 1)
+      ENDIF
+c
+      IF (imdep.GT.400 .OR. jmdep.GT.200) THEN
+         PRINT*, 'imdep ou jmdep trop grand', imdep, jmdep
+         CALL ABORT_GCM("", "", 1)
+      ENDIF
+c
+c calculer les bords a et b de la nouvelle grille
+c
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+c
+c calculer les bords c et d de la nouvelle grille
+c
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+c
+c trouver les indices (indx,indy) de la nouvelle grille sur laquelle
+c un point de l'ancienne grille est tombe.
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+               indx(i,j) = ii
+               indy(i,j) = jj
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c faire une verification
+c
+
+      DO i = 1, imdep
+      DO j = 1, jmdep
+         IF (indx(i,j).GT.imar .OR. indy(i,j).GT.jmar) THEN
+            PRINT*, 'Probleme grave,i,j,indx,indy=',
+     .              i,j,indx(i,j),indy(i,j)
+            call abort_gcm("", "", 1)
+         ENDIF
+      ENDDO
+      ENDDO
+
+c
+c calculer la distance des anciens points avec le nouveau point,
+c on prend ensuite une sorte d'inverse pour ponderation.
+c
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         number(i,j) = 0.0
+         distsom(i,j) = 0.0
+      ENDDO
+      ENDDO
+      DO i = 1, imdep
+      DO j = 1, jmdep
+         dist(i,j) = SQRT ( (xdata(i)-x(indx(i,j)))**2
+     .                     +(ydata(j)-y(indy(i,j)))**2 )
+         distsom(indx(i,j),indy(i,j)) = distsom(indx(i,j),indy(i,j))
+     .                                  + dist(i,j)
+         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j)) +1.
+      ENDDO
+      ENDDO
+      DO i = 1, imdep
+      DO j = 1, jmdep
+         dist(i,j) = 1.0 - dist(i,j)/distsom(indx(i,j),indy(i,j))
+      ENDDO
+      ENDDO
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         number(i,j) = 0.0
+         sortie(i,j) = 0.0
+      ENDDO
+      ENDDO
+      DO i = 1, imdep
+      DO j = 1, jmdep
+         sortie(indx(i,j),indy(i,j)) = sortie(indx(i,j),indy(i,j))
+     .                                 + entree(i,j) * dist(i,j)
+         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j))
+     .                                 + dist(i,j)
+      ENDDO
+      ENDDO
+      DO i = 1, imar
+      DO j = 1, jmar
+         IF (number(i,j) .GT. 0.001) THEN
+         sortie(i,j) = sortie(i,j) / number(i,j)
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+         CALL ABORT_GCM("", "", 1)
+         ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
+
+      SUBROUTINE mask_c_o(imdep, jmdep, xdata, ydata, relief,
+     .                    imar, jmar, x, y, mask)
+c=======================================================================
+c z.x.li (le 1 avril 1994): A partir du champ de relief, on fabrique
+c                           un champ indicateur (masque) terre/ocean
+c                           terre:1; ocean:0
+c
+c Methode naive (voir grille_m)
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL relief(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL mask(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(2200),b(2200),c(1100),d(1100)
+      REAL num_tot(2200,1100), num_oce(2200,1100)
+c
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT_GCM("", "", 1)
+      ENDIF
+c
+
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         num_oce(i,j) = 0.0
+         num_tot(i,j) = 0.0
+      ENDDO
+      ENDDO
+
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+               num_tot(ii,jj) = num_tot(ii,jj) + 1.0
+               IF (.NOT. ( relief(i,j) - 0.9. GE. 1.e-5 ) )
+     .             num_oce(ii,jj) = num_oce(ii,jj) + 1.0
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c
+c
+      DO i = 1, imar
+      DO j = 1, jmar
+         IF (num_tot(i,j) .GT. 0.001) THEN
+           IF ( num_oce(i,j)/num_tot(i,j) - 0.5 .GE. 1.e-5 ) THEN
+              mask(i,j) = 0.
+           ELSE
+              mask(i,j) = 1.
+           ENDIF
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+         CALL ABORT_GCM("", "", 1)
+         ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+c
+c
+
+
+      SUBROUTINE rugosite(imdep, jmdep, xdata, ydata, entree,
+     .                    imar, jmar, x, y, sortie, mask)
+c=======================================================================
+c z.x.li (le 1 avril 1994): Transformer la longueur de rugosite d'une
+c grille fine a une grille grossiere. Sur l'ocean, on impose une valeur
+c fixe (0.001m).
+c
+c Methode naive (voir grille_m)
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL sortie(imar,jmar), mask(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(400),b(400),c(400),d(400)
+      REAL num_tot(400,400)
+      REAL distans(400*400)
+      INTEGER i_proche, j_proche, ij_proche
+#ifdef CRAY
+      INTEGER ISMIN
+#else
+      REAL zzmin
+#endif
+c
+      IF (imar.GT.400 .OR. jmar.GT.400) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT_GCM("", "", 1)
+      ENDIF
+c
+
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         num_tot(i,j) = 0.0
+         sortie(i,j) = 0.0
+      ENDDO
+      ENDDO
+
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+              sortie(ii,jj)  = sortie(ii,jj) + LOG(entree(i,j))
+              num_tot(ii,jj) = num_tot(ii,jj) + 1.0
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+
+      DO i = 1, imar
+      DO j = 1, jmar
+       IF (NINT(mask(i,j)).EQ.1) THEN
+         IF (num_tot(i,j) .GT. 0.0) THEN
+            sortie(i,j) = sortie(i,j) / num_tot(i,j)
+            sortie(i,j) = EXP(sortie(i,j))
+         ELSE
+            PRINT*, 'probleme,i,j=', i,j
+ccc            CALL ABORT_GCM("", "", 1)
+         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
+#ifdef CRAY
+         ij_proche = ISMIN(imdep*jmdep,distans,1)
+#else
+         ij_proche = 1
+         zzmin = distans(ij_proche)
+         DO ii = 2, imdep*jmdep
+            IF (distans(ii).LT.zzmin) THEN
+               zzmin = distans(ii)
+               ij_proche = ii
+            ENDIF
+         ENDDO
+#endif
+         j_proche = (ij_proche-1)/imdep + 1
+         i_proche = ij_proche - (j_proche-1)*imdep
+         PRINT*, "solution:", ij_proche, i_proche, j_proche
+         sortie(i,j) = entree(i_proche,j_proche)
+         ENDIF
+       ELSE
+         sortie(i,j) = 0.001
+       ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
+
+
+      SUBROUTINE sea_ice(imdep, jmdep, xdata, ydata, glace01,
+     .                    imar, jmar, x, y, frac_ice)
+c=======================================================================
+c z.x.li (le 1 avril 1994): Transformer un champ d'indicateur de la
+c glace (1, sinon 0) d'une grille fine a un champ de fraction de glace
+c (entre 0 et 1) dans une grille plus grossiere.
+c
+c Methode naive (voir grille_m)
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL glace01(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL frac_ice(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(400),b(400),c(400),d(400)
+      REAL num_tot(400,400), num_ice(400,400)
+      REAL distans(400*400)
+      INTEGER i_proche, j_proche, ij_proche
+#ifdef CRAY
+      INTEGER ISMIN
+#else
+      REAL zzmin
+#endif
+c
+      IF (imar.GT.400 .OR. jmar.GT.400) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT_GCM("", "", 1)
+      ENDIF
+c
+
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         num_ice(i,j) = 0.0
+         num_tot(i,j) = 0.0
+      ENDDO
+      ENDDO
+
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+             num_tot(ii,jj) = num_tot(ii,jj) + 1.0
+              IF (NINT(glace01(i,j)).EQ.1 ) 
+     .       num_ice(ii,jj) = num_ice(ii,jj) + 1.0
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         IF (num_tot(i,j) .GT. 0.001) THEN
+           IF (num_ice(i,j).GT.0.001) THEN
+            frac_ice(i,j) = num_ice(i,j) / num_tot(i,j)
+           ELSE
+              frac_ice(i,j) = 0.0
+           ENDIF
+         ELSE
+           PRINT*, 'probleme,i,j=', i,j
+ccc           CALL ABORT_GCM("", "", 1)
+         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
+#ifdef CRAY
+         ij_proche = ISMIN(imdep*jmdep,distans,1)
+#else
+         ij_proche = 1
+         zzmin = distans(ij_proche)
+         DO ii = 2, imdep*jmdep
+            IF (distans(ii).LT.zzmin) THEN
+               zzmin = distans(ii)
+               ij_proche = ii
+            ENDIF
+         ENDDO
+#endif
+         j_proche = (ij_proche-1)/imdep + 1
+         i_proche = ij_proche - (j_proche-1)*imdep
+         PRINT*, "solution:", ij_proche, i_proche, j_proche
+         IF (NINT(glace01(i_proche,j_proche)).EQ.1 ) THEN
+            frac_ice(i,j) = 1.0
+         ELSE
+            frac_ice(i,j) = 0.0
+         ENDIF
+         ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
+      SUBROUTINE rugsoro(imrel, jmrel, xrel, yrel, relief,
+     .                    immod, jmmod, xmod, ymod, rugs)
+c=======================================================================
+c Calculer la longueur de rugosite liee au relief en utilisant
+c l'ecart-type dans une maille de 1x1
+C=======================================================================
+      IMPLICIT none
+c
+#ifdef CRAY
+      INTEGER ISMIN
+#else
+      REAL zzmin
+#endif
+c
+      REAL amin, AMAX
+c
+      INTEGER imrel, jmrel
+      REAL xrel(imrel),yrel(jmrel)
+      REAL relief(imrel,jmrel)
+c
+      INTEGER immod, jmmod
+      REAL xmod(immod),ymod(jmmod)
+      REAL rugs(immod,jmmod)
+c
+      INTEGER imtmp, jmtmp
+      PARAMETER (imtmp=360,jmtmp=180)
+      REAL xtmp(imtmp), ytmp(jmtmp)
+      REAL(KIND=8) cham1tmp(imtmp,jmtmp), cham2tmp(imtmp,jmtmp)
+      REAL zzzz
+c
+      INTEGER i, j, ii, jj
+      REAL a(2200),b(2200),c(1100),d(1100)
+      REAL number(2200,1100)
+c
+      REAL distans(400*400)
+      INTEGER i_proche, j_proche, ij_proche
+c
+      IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN
+         PRINT*, 'immod ou jmmod trop grand', immod, jmmod
+         CALL ABORT_GCM("", "", 1)
+      ENDIF
+c
+c Calculs intermediares:
+c
+      xtmp(1) = -180.0 + 360.0/REAL(imtmp) / 2.0
+      DO i = 2, imtmp
+         xtmp(i) = xtmp(i-1) + 360.0/REAL(imtmp)
+      ENDDO
+      DO i = 1, imtmp
+         xtmp(i) = xtmp(i) /180.0 * 4.0*ATAN(1.0)
+      ENDDO
+      ytmp(1) = -90.0 + 180.0/REAL(jmtmp) / 2.0
+      DO j = 2, jmtmp
+         ytmp(j) = ytmp(j-1) + 180.0/REAL(jmtmp)
+      ENDDO
+      DO j = 1, jmtmp
+         ytmp(j) = ytmp(j) /180.0 * 4.0*ATAN(1.0)
+      ENDDO
+c
+      a(1) = xtmp(1) - (xtmp(2)-xtmp(1))/2.0
+      b(1) = (xtmp(1)+xtmp(2))/2.0
+      DO i = 2, imtmp-1
+         a(i) = b(i-1)
+         b(i) = (xtmp(i)+xtmp(i+1))/2.0
+      ENDDO
+      a(imtmp) = b(imtmp-1)
+      b(imtmp) = xtmp(imtmp) + (xtmp(imtmp)-xtmp(imtmp-1))/2.0
+
+      c(1) = ytmp(1) - (ytmp(2)-ytmp(1))/2.0
+      d(1) = (ytmp(1)+ytmp(2))/2.0
+      DO j = 2, jmtmp-1
+         c(j) = d(j-1)
+         d(j) = (ytmp(j)+ytmp(j+1))/2.0
+      ENDDO
+      c(jmtmp) = d(jmtmp-1)
+      d(jmtmp) = ytmp(jmtmp) + (ytmp(jmtmp)-ytmp(jmtmp-1))/2.0
+
+      DO i = 1, imtmp
+      DO j = 1, jmtmp
+         number(i,j) = 0.0
+         cham1tmp(i,j) = 0.0
+         cham2tmp(i,j) = 0.0
+      ENDDO
+      ENDDO
+c
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imtmp
+      DO jj = 1, jmtmp
+        DO i = 1, imrel
+         IF( ( xrel(i)-a(ii).GE.1.e-5.AND.xrel(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xrel(i)-a(ii).LE.1.e-5.AND.xrel(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmrel
+          IF( (yrel(j)-c(jj).GE.1.e-5.AND.yrel(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  yrel(j)-c(jj).LE.1.e-5.AND.yrel(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+              number(ii,jj) = number(ii,jj) + 1.0
+              cham1tmp(ii,jj) = cham1tmp(ii,jj) + relief(i,j)
+              cham2tmp(ii,jj) = cham2tmp(ii,jj) 
+     .                              + relief(i,j)*relief(i,j)
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c
+      DO i = 1, imtmp
+      DO j = 1, jmtmp
+         IF (number(i,j) .GT. 0.001) THEN
+         cham1tmp(i,j) = cham1tmp(i,j) / number(i,j)
+         cham2tmp(i,j) = cham2tmp(i,j) / number(i,j)
+         zzzz=cham2tmp(i,j)-cham1tmp(i,j)**2
+         if (zzzz .lt. 0.0) then
+           if (zzzz .gt. -7.5) then
+             zzzz = 0.0
+             print*,'Pb rugsoro, -7.5 < zzzz < 0, => zzz = 0.0'
+           else
+              stop 'Pb rugsoro, zzzz <-7.5'
+           endif
+         endif
+         cham2tmp(i,j) = SQRT(zzzz)
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+         CALL ABORT_GCM("", "", 1)
+         ENDIF
+      ENDDO
+      ENDDO
+c
+      amin = cham2tmp(1,1)
+      AMAX = cham2tmp(1,1)
+      DO j = 1, jmtmp
+      DO i = 1, imtmp
+         IF (cham2tmp(i,j).GT.AMAX) AMAX = cham2tmp(i,j)
+         IF (cham2tmp(i,j).LT.amin) amin = cham2tmp(i,j)
+      ENDDO
+      ENDDO
+      PRINT*, 'Ecart-type 1x1:', amin, AMAX
+c
+c
+c
+      a(1) = xmod(1) - (xmod(2)-xmod(1))/2.0
+      b(1) = (xmod(1)+xmod(2))/2.0
+      DO i = 2, immod-1
+         a(i) = b(i-1)
+         b(i) = (xmod(i)+xmod(i+1))/2.0
+      ENDDO
+      a(immod) = b(immod-1)
+      b(immod) = xmod(immod) + (xmod(immod)-xmod(immod-1))/2.0
+
+      c(1) = ymod(1) - (ymod(2)-ymod(1))/2.0
+      d(1) = (ymod(1)+ymod(2))/2.0
+      DO j = 2, jmmod-1
+         c(j) = d(j-1)
+         d(j) = (ymod(j)+ymod(j+1))/2.0
+      ENDDO
+      c(jmmod) = d(jmmod-1)
+      d(jmmod) = ymod(jmmod) + (ymod(jmmod)-ymod(jmmod-1))/2.0
+c
+      DO i = 1, immod
+      DO j = 1, jmmod
+         number(i,j) = 0.0
+         rugs(i,j) = 0.0
+      ENDDO
+      ENDDO
+c
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, immod
+      DO jj = 1, jmmod
+        DO i = 1, imtmp
+         IF( ( xtmp(i)-a(ii).GE.1.e-5.AND.xtmp(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xtmp(i)-a(ii).LE.1.e-5.AND.xtmp(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmtmp
+          IF( (ytmp(j)-c(jj).GE.1.e-5.AND.ytmp(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ytmp(j)-c(jj).LE.1.e-5.AND.ytmp(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+              number(ii,jj) = number(ii,jj) + 1.0
+              rugs(ii,jj) = rugs(ii,jj)
+     .                       + LOG(MAX(0.001_8,cham2tmp(i,j)))
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c
+      DO i = 1, immod
+      DO j = 1, jmmod
+         IF (number(i,j) .GT. 0.001) THEN
+         rugs(i,j) = rugs(i,j) / number(i,j)
+         rugs(i,j) = EXP(rugs(i,j))
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+ccc         CALL ABORT_GCM("", "", 1)
+         CALL dist_sphe(xmod(i),ymod(j),xtmp,ytmp,imtmp,jmtmp,distans)
+#ifdef CRAY
+         ij_proche = ISMIN(imtmp*jmtmp,distans,1)
+#else
+         ij_proche = 1
+         zzmin = distans(ij_proche)
+         DO ii = 2, imtmp*jmtmp
+            IF (distans(ii).LT.zzmin) THEN
+               zzmin = distans(ii)
+               ij_proche = ii
+            ENDIF
+         ENDDO
+#endif
+         j_proche = (ij_proche-1)/imtmp + 1
+         i_proche = ij_proche - (j_proche-1)*imtmp
+         PRINT*, "solution:", ij_proche, i_proche, j_proche
+         rugs(i,j) = LOG(MAX(0.001_8,cham2tmp(i_proche,j_proche)))
+         ENDIF
+      ENDDO
+      ENDDO
+c
+      amin = rugs(1,1)
+      AMAX = rugs(1,1)
+      DO j = 1, jmmod
+      DO i = 1, immod
+         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
+         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
+      ENDDO
+      ENDDO
+      PRINT*, 'Ecart-type du modele:', amin, AMAX
+c
+      DO j = 1, jmmod
+      DO i = 1, immod
+         rugs(i,j) = rugs(i,j) / AMAX * 20.0
+      ENDDO
+      ENDDO
+c
+      amin = rugs(1,1)
+      AMAX = rugs(1,1)
+      DO j = 1, jmmod
+      DO i = 1, immod
+         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
+         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
+      ENDDO
+      ENDDO
+      PRINT*, 'Longueur de rugosite du modele:', amin, AMAX
+c
+      RETURN
+      END
+c
+      SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,im,jm,distance)
+c
+c Auteur: Laurent Li (le 30 decembre 1996)
+c
+c Ce programme calcule la distance minimale (selon le grand cercle)
+c entre deux points sur la terre
+c
+c Input:
+      INTEGER im, jm ! dimensions
+      REAL rf_lon ! longitude du point de reference (degres)
+      REAL rf_lat ! latitude du point de reference (degres)
+      REAL rlon(im), rlat(jm) ! longitude et latitude des points
+c
+c Output:
+      REAL distance(im,jm) ! distances en metre
+c
+      REAL rlon1, rlat1
+      REAL rlon2, rlat2
+      REAL dist
+      REAL pa, pb, p, pi
+c
+      REAL radius
+      PARAMETER (radius=6371229.)
+c
+      pi = 4.0 * ATAN(1.0)
+c
+      DO 9999 j = 1, jm
+      DO 9999 i = 1, im
+c
+      rlon1=rf_lon
+      rlat1=rf_lat
+      rlon2=rlon(i)
+      rlat2=rlat(j)
+      pa = pi/2.0 - rlat1*pi/180.0 ! dist. entre pole n et point a
+      pb = pi/2.0 - rlat2*pi/180.0 ! dist. entre pole n et point b
+      p = (rlon1-rlon2)*pi/180.0 ! angle entre a et b (leurs meridiens)
+c
+      dist = ACOS( COS(pa)*COS(pb) + SIN(pa)*SIN(pb)*COS(p))
+      dist = radius * dist
+      distance(i,j) = dist
+c
+ 9999 CONTINUE
+c
+      END
Index: LMDZ5/trunk/libf/dyn3d_common/grid_noro.F
===================================================================
--- LMDZ5/trunk/libf/dyn3d_common/grid_noro.F	(revision 1944)
+++ LMDZ5/trunk/libf/dyn3d_common/grid_noro.F	(revision 1944)
@@ -0,0 +1,521 @@
+!
+! $Id$
+!
+c
+c
+      SUBROUTINE grid_noro(imdep, jmdep, xdata, ydata, zdata,
+     .             imar, jmar, x, y,
+     .             zphi,zmea,zstd,zsig,zgam,zthe,
+     .             zpic,zval,mask)
+c=======================================================================
+c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
+c
+c      Compute the Parameters of the SSO scheme as described in
+c      LOTT & MILLER (1997) and LOTT(1999).
+c      Target points are on a rectangular grid:
+c      iim+1 latitudes including North and South Poles;
+c      jjm+1 longitudes, with periodicity jjm+1=1.
+c      aux poles.  At the poles the fields value is repeated
+c      jjm+1 time.
+c      The parameters a,b,c,d represent the limite of the target
+c      gridpoint region. The means over this region are calculated
+c      from USN data, ponderated by a weight proportional to the 
+c      surface occupated by the data inside the model gridpoint area.
+c      In most circumstances, this weight is the ratio between the
+c      surface of the USN gridpoint area and the surface of the
+c      model gridpoint area. 
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X and Y input field
+c        xdata, ydata: coordinates X and Y input field
+c        zdata: Input field
+c        In this version it is assumed that the entry data come from
+c        the USNavy dataset: imdep=iusn=2160, jmdep=jusn=1080.
+c OUTPUT:
+c        imar, jmar: dimensions X and Y Output field
+c        x, y: ccordinates  X and Y Output field.
+c             zmea:  Mean orographie   
+c             zstd:  Standard deviation
+c             zsig:  Slope
+c             zgam:  Anisotropy
+c             zthe:  Orientation of the small axis
+c             zpic:  Maximum altitude
+c             zval:  Minimum altitude
+C=======================================================================
+
+      IMPLICIT INTEGER (I,J)
+      IMPLICIT REAL(X,Z) 
+      
+	  parameter(iusn=2160,jusn=1080,iext=216, epsfra = 1.e-5)
+#include "dimensions.h"
+	  REAL xusn(iusn+2*iext),yusn(jusn+2)	
+      REAL zusn(iusn+2*iext,jusn+2)
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL zdata(imdep,jmdep)
+c
+      INTEGER imar, jmar
+  
+C INTERMEDIATE FIELDS  (CORRELATIONS OF OROGRAPHY GRADIENT)
+
+      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
+      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
+      REAL weight(iim+1,jjm+1)
+
+C CORRELATIONS OF USN OROGRAPHY GRADIENTS
+
+      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
+      REAL zxtzyusn(iusn+2*iext,jusn+2)
+      REAL x(imar+1),y(jmar),zphi(imar+1,jmar)
+      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
+      REAL zmea0(imar+1,jmar) ! GK211005 (CG)
+      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
+      REAL zpic(imar+1,jmar),zval(imar+1,jmar)
+cxxx PB     integer mask(imar+1,jmar)
+      real mask(imar+1,jmar), mask_tmp(imar+1,jmar)
+      real num_tot(2200,1100),num_lan(2200,1100)
+c
+      REAL a(2200),b(2200),c(1100),d(1100)
+      logical masque_lu
+c
+      print *,' parametres de l orographie a l echelle sous maille' 
+      xpi=acos(-1.)
+      rad    = 6 371 229.
+      zdeltay=2.*xpi/REAL(jusn)*rad
+c
+c utilise-t'on un masque lu?
+c
+      masque_lu = .true.
+      if (maxval(mask) == -99999 .and. minval(mask) == -99999) then
+        masque_lu= .false.
+        masque = 0.0
+      endif
+      write(*,*)'Masque lu', masque_lu
+c
+c  quelques tests de dimensions:
+c    
+c
+      if(iim.ne.imar) STOP 'Problem dim. x'
+      if(jjm.ne.jmar-1) STOP 'Problem dim. y'
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar or jmar too big', imar, jmar
+         CALL ABORT_GCM("GRID_NORO", "", 1)
+      ENDIF
+
+      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
+         print *,' imdep or jmdep bad dimensions:',imdep,jmdep
+         call abort_gcm("grid_noro", "", 1)
+      ENDIF
+
+      IF(imar+1.ne.iim+1.or.jmar.ne.jjm+1)THEN
+        print *,' imar or jmar bad dimensions:',imar,jmar
+        call abort_gcm("grid_noro", "", 1)
+      ENDIF
+
+
+c      print *,'xdata:',xdata
+c      print *,'ydata:',ydata
+c      print *,'x:',x
+c      print *,'y:',y
+c
+C  EXTENSION OF THE USN DATABASE TO POCEED COMPUTATIONS AT
+C  BOUNDARIES:
+c
+      DO j=1,jusn
+        yusn(j+1)=ydata(j)
+      DO i=1,iusn
+        zusn(i+iext,j+1)=zdata(i,j)
+        xusn(i+iext)=xdata(i)
+      ENDDO
+      DO i=1,iext
+        zusn(i,j+1)=zdata(iusn-iext+i,j)
+        xusn(i)=xdata(iusn-iext+i)-2.*xpi
+        zusn(iusn+iext+i,j+1)=zdata(i,j)
+        xusn(iusn+iext+i)=xdata(i)+2.*xpi
+      ENDDO
+      ENDDO
+
+        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
+        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
+       DO i=1,iusn/2+iext
+        zusn(i,1)=zusn(i+iusn/2,2)
+        zusn(i+iusn/2+iext,1)=zusn(i,2)
+        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
+        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
+       ENDDO
+c  
+c COMPUTE LIMITS OF MODEL GRIDPOINT AREA
+C     ( REGULAR GRID)
+c
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar+1) = b(imar)
+      b(imar+1) = x(imar+1) + (x(imar+1)-x(imar))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+c
+c  initialisations:
+c
+      DO i = 1, imar+1
+      DO j = 1, jmar
+         weight(i,j) = 0.0
+         zxtzx(i,j)  = 0.0
+         zytzy(i,j)  = 0.0
+         zxtzy(i,j)  = 0.0
+         ztz(i,j)    = 0.0
+         zmea(i,j)   = 0.0
+         zpic(i,j)  =-1.E+10
+         zval(i,j)  = 1.E+10
+      ENDDO
+      ENDDO
+c
+c  COMPUTE SLOPES CORRELATIONS ON USN GRID
+c
+         DO j = 1,jusn+2 
+         DO i = 1, iusn+2*iext
+            zytzyusn(i,j)=0.0
+            zxtzxusn(i,j)=0.0
+            zxtzyusn(i,j)=0.0
+         ENDDO
+         ENDDO
+
+
+         DO j = 2,jusn+1 
+            zdeltax=zdeltay*cos(yusn(j))
+         DO i = 2, iusn+2*iext-1
+            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
+            zxtzxusn(i,j)=(zusn(i+1,j)-zusn(i-1,j))**2/zdeltax**2
+            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
+     *                   *(zusn(i+1,j)-zusn(i-1,j))/zdeltax
+         ENDDO
+         ENDDO
+c
+c  SUMMATION OVER GRIDPOINT AREA
+c 
+      zleny=xpi/REAL(jusn)*rad
+      xincr=xpi/2./REAL(jusn)
+       DO ii = 1, imar+1
+       DO jj = 1, jmar
+       num_tot(ii,jj)=0.
+       num_lan(ii,jj)=0.
+c        PRINT *,' iteration ii jj:',ii,jj
+         DO j = 2,jusn+1 
+c         DO j = 3,jusn 
+            zlenx=zleny*cos(yusn(j))
+            zdeltax=zdeltay*cos(yusn(j))
+            zbordnor=(c(jj)-yusn(j)+xincr)*rad
+            zbordsud=(yusn(j)-d(jj)+xincr)*rad
+            weighy=AMAX1(0.,
+     *             amin1(zbordnor,zbordsud,zleny))
+         IF(weighy.ne.0)THEN
+         DO i = 2, iusn+2*iext-1
+            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
+            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
+            weighx=AMAX1(0.,
+     *             amin1(zbordest,zbordoue,zlenx))
+            IF(weighx.ne.0)THEN
+            num_tot(ii,jj)=num_tot(ii,jj)+1.0
+            if(zusn(i,j).ge.1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
+            weight(ii,jj)=weight(ii,jj)+weighx*weighy
+            zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
+            zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
+            zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
+            ztz(ii,jj)  =ztz(ii,jj)  +zusn(i,j)*zusn(i,j)*weighx*weighy
+c mean
+            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
+c peacks
+            zpic(ii,jj)=amax1(zpic(ii,jj),zusn(i,j))
+c valleys
+            zval(ii,jj)=amin1(zval(ii,jj),zusn(i,j))
+            ENDIF
+         ENDDO
+         ENDIF
+         ENDDO
+       ENDDO
+       ENDDO
+c
+c  COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND
+C  LOTT (1999) SSO SCHEME.
+c
+      zllmmea=0.
+      zllmstd=0.
+      zllmsig=0.
+      zllmgam=0.
+      zllmpic=0.
+      zllmval=0.
+      zllmthe=0.
+      zminthe=0.
+c     print 100,' '
+c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
+       DO ii = 1, imar+1
+       DO jj = 1, jmar
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Mask
+cXXX           if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
+cXXX             mask(ii,jj)=1
+cXXX           else
+cXXX             mask(ii,jj)=0
+cXXX           ENDIF
+             if (.not. masque_lu) then
+               mask(ii,jj) = num_lan(ii,jj)/num_tot(ii,jj)
+             endif
+c  Mean Orography:
+           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
+           zxtzx(ii,jj)=zxtzx(ii,jj)/weight(ii,jj)
+           zytzy(ii,jj)=zytzy(ii,jj)/weight(ii,jj)
+           zxtzy(ii,jj)=zxtzy(ii,jj)/weight(ii,jj)
+           ztz(ii,jj)  =ztz(ii,jj)/weight(ii,jj)
+c  Standard deviation:
+           zstd(ii,jj)=sqrt(AMAX1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
+         ELSE
+            PRINT*, 'probleme,ii,jj=', ii,jj
+         ENDIF
+       ENDDO
+       ENDDO
+
+C CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES:
+
+       DO ii = 1, imar+1
+         zxtzx(ii,1)=zxtzx(ii,2)
+         zxtzx(ii,jmar)=zxtzx(ii,jmar-1)
+         zxtzy(ii,1)=zxtzy(ii,2)
+         zxtzy(ii,jmar)=zxtzy(ii,jmar-1)
+         zytzy(ii,1)=zytzy(ii,2)
+         zytzy(ii,jmar)=zytzy(ii,jmar-1)
+       ENDDO
+
+C  FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME.
+
+C  FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
+
+       zmea0(:,:) = zmea(:,:) ! GK211005 (CG) on sauvegarde la topo non lissee
+       CALL MVA9(zmea,iim+1,jjm+1)
+       CALL MVA9(zstd,iim+1,jjm+1)
+       CALL MVA9(zpic,iim+1,jjm+1)
+       CALL MVA9(zval,iim+1,jjm+1)
+       CALL MVA9(zxtzx,iim+1,jjm+1)
+       CALL MVA9(zxtzy,iim+1,jjm+1) 
+       CALL MVA9(zytzy,iim+1,jjm+1)
+CXXX   Masque prenant en compte maximum de terre
+CXXX  On seuil a 10% de terre de terre car en dessous les parametres de surface n'on
+CXXX pas de sens (PB)
+       mask_tmp= 0.0
+       WHERE(mask .GE. 0.1) mask_tmp = 1.
+
+       DO ii = 1, imar
+       DO jj = 1, jmar
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Coefficients K, L et M:
+           xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
+           xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
+           xm=zxtzy(ii,jj)
+           xp=xk-sqrt(xl**2+xm**2)
+           xq=xk+sqrt(xl**2+xm**2)
+           xw=1.e-8
+           if(xp.le.xw) xp=0.
+           if(xq.le.xw) xq=xw
+           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
+c slope: 
+cXXX           zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
+cXXXc isotropy:
+cXXX           zgam(ii,jj)=xp/xq*mask(ii,jj)
+cXXXc angle theta:
+cXXX           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
+cXXX           zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
+cXXX           zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
+cXXX           zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
+cXXX           zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
+cXXX           zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
+CXX* PB modif pour maque de terre fractionnaire
+c slope: 
+           zsig(ii,jj)=sqrt(xq)*mask_tmp(ii,jj)
+c isotropy:
+           zgam(ii,jj)=xp/xq*mask_tmp(ii,jj)
+c angle theta:
+           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask_tmp(ii,jj)
+           ! GK211005 (CG) ne pas forcement lisser la topo
+           ! zphi(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
+           zphi(ii,jj)=zmea0(ii,jj)*mask_tmp(ii,jj)
+           !
+           zmea(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
+           zpic(ii,jj)=zpic(ii,jj)*mask_tmp(ii,jj)
+           zval(ii,jj)=zval(ii,jj)*mask_tmp(ii,jj)
+           zstd(ii,jj)=zstd(ii,jj)*mask_tmp(ii,jj)
+c          print 101,ii,jj,
+c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
+c    *           zthe(ii,jj)
+c101  format(1x,2(1x,i2),2(1x,f7.1),1x,f7.4,2x,f4.2,1x,f5.1)     
+         ELSE
+c           PRINT*, 'probleme,ii,jj=', ii,jj
+         ENDIF
+      zllmmea=AMAX1(zmea(ii,jj),zllmmea)
+      zllmstd=AMAX1(zstd(ii,jj),zllmstd)
+      zllmsig=AMAX1(zsig(ii,jj),zllmsig)
+      zllmgam=AMAX1(zgam(ii,jj),zllmgam)
+      zllmthe=AMAX1(zthe(ii,jj),zllmthe)
+      zminthe=amin1(zthe(ii,jj),zminthe)
+      zllmpic=AMAX1(zpic(ii,jj),zllmpic)
+      zllmval=AMAX1(zval(ii,jj),zllmval)
+       ENDDO
+       ENDDO
+      print *,'  MEAN ORO:',zllmmea
+      print *,'  ST. DEV.:',zllmstd
+      print *,'  PENTE:',zllmsig
+      print *,' ANISOTROP:',zllmgam
+      print *,'  ANGLE:',zminthe,zllmthe	
+      print *,'  pic:',zllmpic
+      print *,'  val:',zllmval
+      
+C
+c gamma and theta a 1. and 0. at poles
+c
+      DO jj=1,jmar
+      zmea(imar+1,jj)=zmea(1,jj)
+      zphi(imar+1,jj)=zphi(1,jj)
+      zpic(imar+1,jj)=zpic(1,jj)
+      zval(imar+1,jj)=zval(1,jj)
+      zstd(imar+1,jj)=zstd(1,jj)
+      zsig(imar+1,jj)=zsig(1,jj)
+      zgam(imar+1,jj)=zgam(1,jj)
+      zthe(imar+1,jj)=zthe(1,jj)
+      ENDDO
+
+
+      zmeanor=0.0
+      zmeasud=0.0
+      zstdnor=0.0
+      zstdsud=0.0
+      zsignor=0.0
+      zsigsud=0.0
+      zweinor=0.0
+      zweisud=0.0
+      zpicnor=0.0
+      zpicsud=0.0                                   
+      zvalnor=0.0
+      zvalsud=0.0 
+
+      DO ii=1,imar
+      zweinor=zweinor+              weight(ii,   1)
+      zweisud=zweisud+              weight(ii,jmar)
+      zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)
+      zmeasud=zmeasud+zmea(ii,jmar)*weight(ii,jmar)
+      zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)
+      zstdsud=zstdsud+zstd(ii,jmar)*weight(ii,jmar)
+      zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)
+      zsigsud=zsigsud+zsig(ii,jmar)*weight(ii,jmar)
+      zpicnor=zpicnor+zpic(ii,   1)*weight(ii,   1)
+      zpicsud=zpicsud+zpic(ii,jmar)*weight(ii,jmar)
+      zvalnor=zvalnor+zval(ii,   1)*weight(ii,   1)
+      zvalsud=zvalsud+zval(ii,jmar)*weight(ii,jmar)
+      ENDDO
+
+      DO ii=1,imar+1
+      zmea(ii,   1)=zmeanor/zweinor
+      zmea(ii,jmar)=zmeasud/zweisud
+      zphi(ii,   1)=zmeanor/zweinor
+      zphi(ii,jmar)=zmeasud/zweisud
+      zpic(ii,   1)=zpicnor/zweinor
+      zpic(ii,jmar)=zpicsud/zweisud
+      zval(ii,   1)=zvalnor/zweinor
+      zval(ii,jmar)=zvalsud/zweisud
+      zstd(ii,   1)=zstdnor/zweinor
+      zstd(ii,jmar)=zstdsud/zweisud
+      zsig(ii,   1)=zsignor/zweinor
+      zsig(ii,jmar)=zsigsud/zweisud
+      zgam(ii,   1)=1.
+      zgam(ii,jmar)=1.
+      zthe(ii,   1)=0.
+      zthe(ii,jmar)=0.
+      ENDDO
+
+      RETURN
+      END
+
+      SUBROUTINE MVA9(X,IMAR,JMAR)
+
+C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
+
+      REAL X(IMAR,JMAR),XF(IMAR,JMAR)
+      real WEIGHTpb(-1:1,-1:1)
+
+
+      SUM=0.
+      DO IS=-1,1
+        DO JS=-1,1
+          WEIGHTpb(IS,JS)=1./REAL((1+IS**2)*(1+JS**2))
+          SUM=SUM+WEIGHTpb(IS,JS)
+        ENDDO
+      ENDDO
+      
+c     WRITE(*,*) 'MVA9 ', IMAR, JMAR
+c     WRITE(*,*) 'MVA9 ', WEIGHTpb
+c     WRITE(*,*) 'MVA9 SUM ', SUM
+      DO IS=-1,1
+        DO JS=-1,1
+          WEIGHTpb(IS,JS)=WEIGHTpb(IS,JS)/SUM
+        ENDDO
+      ENDDO
+
+      DO J=2,JMAR-1
+        DO I=2,IMAR-1
+          XF(I,J)=0.
+          DO IS=-1,1
+            DO JS=-1,1
+              XF(I,J)=XF(I,J)+X(I+IS,J+JS)*WEIGHTpb(IS,JS)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDDO
+
+      DO J=2,JMAR-1
+        XF(1,J)=0.
+        IS=IMAR-1
+        DO JS=-1,1 
+          XF(1,J)=XF(1,J)+X(IS,J+JS)*WEIGHTpb(-1,JS)
+        ENDDO
+        DO IS=0,1 
+          DO JS=-1,1 
+            XF(1,J)=XF(1,J)+X(1+IS,J+JS)*WEIGHTpb(IS,JS)
+          ENDDO
+        ENDDO
+        XF(IMAR,J)=XF(1,J)
+      ENDDO
+
+      DO I=1,IMAR
+        XF(I,1)=XF(I,2)
+        XF(I,JMAR)=XF(I,JMAR-1)
+      ENDDO
+
+      DO I=1,IMAR
+        DO J=1,JMAR
+          X(I,J)=XF(I,J)
+        ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
Index: LMDZ5/trunk/libf/dyn3d_common/juldate.F
===================================================================
--- LMDZ5/trunk/libf/dyn3d_common/juldate.F	(revision 1944)
+++ LMDZ5/trunk/libf/dyn3d_common/juldate.F	(revision 1944)
@@ -0,0 +1,33 @@
+!
+! $Id$
+!
+	subroutine juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec)
+c	Sous-routine de changement de date:
+c	gregorien>>>date julienne
+c	En entree:an,mois,jour,heure,min.,sec.
+c	En sortie:tjd
+	implicit real (a-h,o-z)
+	frac=((os/60.+om)/60.+oh)/24.
+	ojou=dble(ijou)+frac
+	    year=dble(ian)
+	    rmon=dble(imoi)
+	if (imoi .le. 2) then
+	    year=year-1.
+	    rmon=rmon+12.
+	endif
+	cf=year+(rmon/100.)+(ojou/10000.)
+	if (cf .ge. 1582.1015) then
+	    a=int(year/100)
+	    b=2-a+int(a/4)
+	else
+	    b=0
+	endif
+	tjd=int(365.25*year)+int(30.6001*(rmon+1))+int(ojou)
+     +   +1720994.5+b
+        tjdsec=(ojou-int(ojou))+(tjd-int(tjd))
+        tjd=int(tjd)+int(tjdsec)
+	tjdsec=tjdsec-int(tjdsec)
+	return
+	end
+
+
Index: LMDZ5/trunk/libf/dyn3d_common/pres2lev_mod.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3d_common/pres2lev_mod.F90	(revision 1944)
+++ LMDZ5/trunk/libf/dyn3d_common/pres2lev_mod.F90	(revision 1944)
@@ -0,0 +1,79 @@
+! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $
+!
+MODULE pres2lev_mod
+
+CONTAINS 
+
+!******************************************************
+SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn,ni,nj,ok_invertp)
+!
+! interpolation lineaire pour passer
+! a une nouvelle discretisation verticale pour
+! les variables de GCM
+! Francois Forget (01/1995)
+! MOdif remy roca 12/97 pour passer de pres2sig
+! Modif F.Codron 07/08 po en 3D
+!**********************************************************
+
+  IMPLICIT NONE
+
+!   Declarations:
+! ==============
+!
+!  ARGUMENTS
+!  """""""""
+  LOGICAL, INTENT(IN) :: ok_invertp
+  INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
+  INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
+  
+  INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
+  REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille
+  REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille
+
+  REAL, INTENT(IN)  :: varo(ni*nj,lmo) ! var dans l'ancienne grille
+  REAL, INTENT(OUT) :: varn(ni*nj,lmn) ! var dans la nouvelle grille
+
+  REAL :: zvaro(ni*nj,lmo),zpo(ni*nj,lmo)
+
+! Autres variables
+! """"""""""""""""
+  INTEGER ::  ln ,lo, k
+  REAL    :: coef
+
+
+! Inversion de l'ordre des niveaux verticaux
+  IF (ok_invertp) THEN
+    DO lo=1,lmo
+      DO k=1,ni*nj
+        zpo(k,lo)=po(k,lmo+1-lo)
+        zvaro(k,lo)=varo(k,lmo+1-lo)
+      ENDDO
+    ENDDO
+  ELSE
+    DO lo=1,lmo
+      DO k=1,ni*nj
+        zpo(k,lo)=po(k,lo)
+        zvaro(k,lo)=varo(k,lo)
+      ENDDO
+    ENDDO
+  ENDIF 
+
+  DO ln=1,lmn
+    DO lo=1,lmo-1
+      DO k=1,ni*nj
+        IF (pn(k,ln) >= zpo(k,1) ) THEN
+          varn(k,ln) = zvaro(k,1)
+        ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN
+          varn(k,ln) = zvaro(k,lmo)
+        ELSE IF ( pn(k,ln) <= zpo(k,lo) .AND. pn(k,ln) > zpo(k,lo+1) ) THEN
+          coef = (pn(k,ln)-zpo(k,lo)) / (zpo(k,lo+1)-zpo(k,lo))
+          varn(k,ln) = zvaro(k,lo) + coef*(zvaro(k,lo+1)-zvaro(k,lo))
+        ENDIF
+         
+      ENDDO  
+    ENDDO
+  ENDDO                
+
+END SUBROUTINE pres2lev    
+
+END MODULE pres2lev_mod
Index: LMDZ5/trunk/libf/dyn3d_common/ran1.F
===================================================================
--- LMDZ5/trunk/libf/dyn3d_common/ran1.F	(revision 1944)
+++ LMDZ5/trunk/libf/dyn3d_common/ran1.F	(revision 1944)
@@ -0,0 +1,34 @@
+!
+! $Id$
+!
+      FUNCTION RAN1(IDUM)
+      DIMENSION R(97)
+      save r
+      save iff,ix1,ix2,ix3
+      PARAMETER (M1=259200,IA1=7141,IC1=54773,RM1=3.8580247E-6)
+      PARAMETER (M2=134456,IA2=8121,IC2=28411,RM2=7.4373773E-6)
+      PARAMETER (M3=243000,IA3=4561,IC3=51349)
+      DATA IFF /0/
+      IF (IDUM.LT.0.OR.IFF.EQ.0) THEN
+        IFF=1
+        IX1=MOD(IC1-IDUM,M1)
+        IX1=MOD(IA1*IX1+IC1,M1)
+        IX2=MOD(IX1,M2)
+        IX1=MOD(IA1*IX1+IC1,M1)
+        IX3=MOD(IX1,M3)
+        DO 11 J=1,97
+          IX1=MOD(IA1*IX1+IC1,M1)
+          IX2=MOD(IA2*IX2+IC2,M2)
+          R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
+11      CONTINUE
+        IDUM=1
+      ENDIF
+      IX1=MOD(IA1*IX1+IC1,M1)
+      IX2=MOD(IA2*IX2+IC2,M2)
+      IX3=MOD(IA3*IX3+IC3,M3)
+      J=1+(97*IX3)/M3
+      IF(J.GT.97.OR.J.LT.1) stop 1
+      RAN1=R(J)
+      R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
+      RETURN
+      END
Index: LMDZ5/trunk/libf/dyn3dmem/defrun.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/defrun.F	(revision 1943)
+++ 	(revision )
@@ -1,497 +1,0 @@
-!
-! $Id$
-!
-c
-c
-      SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
-c
-      USE control_mod
-      IMPLICIT NONE
-c-----------------------------------------------------------------------
-c     Auteurs :   L. Fairhead , P. Le Van  .
-c
-c     Arguments :
-c
-c     tapedef   :
-c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
-c     -metres  du zoom  avec  celles lues sur le fichier start .
-c      clesphy0 :  sortie  .
-c
-       LOGICAL etatinit
-       INTEGER tapedef
-
-       INTEGER        longcles
-       PARAMETER(     longcles = 20 )
-       REAL clesphy0( longcles )
-c
-c   Declarations :
-c   --------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "logic.h"
-#include "serre.h"
-#include "comdissnew.h"
-#include "clesph0.h"
-c
-c
-c   local:
-c   ------
-
-      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
-      INTEGER   tapeout
-      REAL clonn,clatt,grossismxx,grossismyy
-      REAL dzoomxx,dzoomyy,tauxx,tauyy
-      LOGICAL  fxyhypbb, ysinuss
-      INTEGER i
-      
-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 de tapedef : ** 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  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  grossismx ,
-c    grossismy,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( tapedef,file ='gcm.def',status='old',form='formatted')
-
-
-      READ (tapedef,9000) ch1,ch2,ch3
-      WRITE(tapeout,9000) ch1,ch2,ch3
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dayref
-      WRITE(tapeout,9001) ch1,'dayref'
-      WRITE(tapeout,*)    dayref
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    anneeref
-      WRITE(tapeout,9001) ch1,'anneeref'
-      WRITE(tapeout,*)    anneeref
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nday
-      WRITE(tapeout,9001) ch1,'nday'
-      WRITE(tapeout,*)    nday
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    day_step
-      WRITE(tapeout,9001) ch1,'day_step'
-      WRITE(tapeout,*)    day_step
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iperiod
-      WRITE(tapeout,9001) ch1,'iperiod'
-      WRITE(tapeout,*)    iperiod
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iapp_tracvl
-      WRITE(tapeout,9001) ch1,'iapp_tracvl'
-      WRITE(tapeout,*)    iapp_tracvl
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iconser
-      WRITE(tapeout,9001) ch1,'iconser'
-      WRITE(tapeout,*)    iconser
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iecri
-      WRITE(tapeout,9001) ch1,'iecri'
-      WRITE(tapeout,*)    iecri
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    periodav
-      WRITE(tapeout,9001) ch1,'periodav'
-      WRITE(tapeout,*)    periodav
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dissip_period
-      WRITE(tapeout,9001) ch1,'dissip_period'
-      WRITE(tapeout,*)    dissip_period
-
-ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
-ccc
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    lstardis
-      WRITE(tapeout,9001) ch1,'lstardis'
-      WRITE(tapeout,*)    lstardis
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nitergdiv
-      WRITE(tapeout,9001) ch1,'nitergdiv'
-      WRITE(tapeout,*)    nitergdiv
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nitergrot
-      WRITE(tapeout,9001) ch1,'nitergrot'
-      WRITE(tapeout,*)    nitergrot
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    niterh
-      WRITE(tapeout,9001) ch1,'niterh'
-      WRITE(tapeout,*)    niterh
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetagdiv
-      WRITE(tapeout,9001) ch1,'tetagdiv'
-      WRITE(tapeout,*)    tetagdiv
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetagrot
-      WRITE(tapeout,9001) ch1,'tetagrot'
-      WRITE(tapeout,*)    tetagrot
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetatemp
-      WRITE(tapeout,9001) ch1,'tetatemp'
-      WRITE(tapeout,*)    tetatemp
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    coefdis
-      WRITE(tapeout,9001) ch1,'coefdis'
-      WRITE(tapeout,*)    coefdis
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    purmats
-      WRITE(tapeout,9001) ch1,'purmats'
-      WRITE(tapeout,*)    purmats
-
-c    ...............................................................
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iflag_phys
-      WRITE(tapeout,9001) ch1,'iflag_phys'
-      WRITE(tapeout,*)    iflag_phys
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iphysiq
-      WRITE(tapeout,9001) ch1,'iphysiq'
-      WRITE(tapeout,*)    iphysiq
-
-
-ccc   .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ...
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    cycle_diurne
-      WRITE(tapeout,9001) ch1,'cycle_diurne'
-      WRITE(tapeout,*)    cycle_diurne
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    soil_model
-      WRITE(tapeout,9001) ch1,'soil_model'
-      WRITE(tapeout,*)    soil_model
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    new_oliq
-      WRITE(tapeout,9001) ch1,'new_oliq'
-      WRITE(tapeout,*)    new_oliq
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_orodr
-      WRITE(tapeout,9001) ch1,'ok_orodr'
-      WRITE(tapeout,*)    ok_orodr
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_orolf
-      WRITE(tapeout,9001) ch1,'ok_orolf'
-      WRITE(tapeout,*)    ok_orolf
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_limitvrai
-      WRITE(tapeout,9001) ch1,'ok_limitvrai'
-      WRITE(tapeout,*)    ok_limitvrai
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nbapp_rad
-      WRITE(tapeout,9001) ch1,'nbapp_rad'
-      WRITE(tapeout,*)    nbapp_rad
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iflag_con
-      WRITE(tapeout,9001) ch1,'iflag_con'
-      WRITE(tapeout,*)    iflag_con
-
-      DO i = 1, longcles
-       clesphy0(i) = 0.
-      ENDDO
-                          clesphy0(1) = REAL( iflag_con )
-                          clesphy0(2) = REAL( nbapp_rad )
-
-       IF( cycle_diurne  ) clesphy0(3) =  1.
-       IF(   soil_model  ) clesphy0(4) =  1.
-       IF(     new_oliq  ) clesphy0(5) =  1.
-       IF(     ok_orodr  ) clesphy0(6) =  1.
-       IF(     ok_orolf  ) clesphy0(7) =  1.
-       IF(  ok_limitvrai ) clesphy0(8) =  1.
-
-
-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 (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clonn
-      WRITE(tapeout,9001) ch1,'clon'
-      WRITE(tapeout,*)    clonn
-      IF( ABS(clon - clonn).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de clon passee par run.def est diffe
-     *rente de  celle lue sur le fichier  start '
-        STOP
-      ENDIF
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clatt
-      WRITE(tapeout,9001) ch1,'clat'
-      WRITE(tapeout,*)    clatt
-
-      IF( ABS(clat - clatt).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de clat passee par run.def est diffe
-     *rente de  celle lue sur le fichier  start '
-        STOP
-      ENDIF
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismxx
-      WRITE(tapeout,9001) ch1,'grossismx'
-      WRITE(tapeout,*)    grossismxx
-
-      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de grossismx passee par run.def est
-     , differente de celle lue sur le fichier  start '
-        STOP
-      ENDIF
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismyy
-      WRITE(tapeout,9001) ch1,'grossismy'
-      WRITE(tapeout,*)    grossismyy
-
-      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de grossismy passee par run.def est
-     , differente de celle lue sur le fichier  start '
-        STOP
-      ENDIF
-      
-      IF( grossismx.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismx < 1 .   *** '
-         STOP
-      ELSE
-         alphax = 1. - 1./ grossismx
-      ENDIF
-
-
-      IF( grossismy.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
-         STOP
-      ELSE
-         alphay = 1. - 1./ grossismy
-      ENDIF
-
-c
-c    alphax et alphay sont les anciennes formulat. des grossissements
-c
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    fxyhypbb
-      WRITE(tapeout,9001) ch1,'fxyhypbb'
-      WRITE(tapeout,*)    fxyhypbb
-
-      IF( .NOT.fxyhypb )  THEN
-           IF( fxyhypbb )     THEN
-            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
-            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est F'
-     *,      '                   alors  qu il est  T  sur  run.def  ***'
-              STOP
-           ENDIF
-      ELSE
-           IF( .NOT.fxyhypbb )   THEN
-            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
-            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est t'
-     *,      '                   alors  qu il est  F  sur  run.def  ***'
-              STOP
-           ENDIF
-      ENDIF
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomxx
-      WRITE(tapeout,9001) ch1,'dzoomx'
-      WRITE(tapeout,*)    dzoomxx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomyy
-      WRITE(tapeout,9001) ch1,'dzoomy'
-      WRITE(tapeout,*)    dzoomyy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauxx
-      WRITE(tapeout,9001) ch1,'taux'
-      WRITE(tapeout,*)    tauxx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauyy
-      WRITE(tapeout,9001) ch1,'tauy'
-      WRITE(tapeout,*)    tauyy
-
-      IF( fxyhypb )  THEN
-
-       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
-        WRITE(tapeout,*)' La valeur de dzoomx passee par run.def est dif
-     *ferente de celle lue sur le fichier  start '
-        CALL ABORT
-       ENDIF
-
-       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
-        WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
-     *ferente de celle lue sur le fichier  start '
-        CALL ABORT
-       ENDIF
-
-       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
-        WRITE(6,*)' La valeur de taux passee par run.def est differente
-     *  de celle lue sur le fichier  start '
-        CALL ABORT
-       ENDIF
-
-       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
-        WRITE(6,*)' La valeur de tauy passee par run.def est differente
-     *  de celle lue sur le fichier  start '
-        CALL ABORT
-       ENDIF
-
-      ENDIF
-      
-cc
-      IF( .NOT.fxyhypb  )  THEN
-        READ (tapedef,9001) ch1,ch4
-        READ (tapedef,*)    ysinuss
-        WRITE(tapeout,9001) ch1,'ysinus'
-        WRITE(tapeout,*)    ysinuss
-
-
-        IF( .NOT.ysinus )  THEN
-           IF( ysinuss )     THEN
-              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
-              WRITE(tapeout,*)'** ysinus lu sur le fichier start est F',
-     *       ' alors  qu il est  T  sur  run.def  ***'
-              STOP
-           ENDIF
-        ELSE
-           IF( .NOT.ysinuss )   THEN
-              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
-              WRITE(tapeout,*)'** ysinus lu sur le fichier start est T',
-     *       ' alors  qu il est  F  sur  run.def  ***'
-              STOP
-           ENDIF
-        ENDIF
-      ENDIF
-c
-      WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
-
-      CLOSE(tapedef)
-
-      RETURN
-c   ...............................................
-c
-100   CONTINUE
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clon
-      WRITE(tapeout,9001) ch1,'clon'
-      WRITE(tapeout,*)    clon
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clat
-      WRITE(tapeout,9001) ch1,'clat'
-      WRITE(tapeout,*)    clat
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismx
-      WRITE(tapeout,9001) ch1,'grossismx'
-      WRITE(tapeout,*)    grossismx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismy
-      WRITE(tapeout,9001) ch1,'grossismy'
-      WRITE(tapeout,*)    grossismy
-
-      IF( grossismx.LT.1. )  THEN
-        WRITE(tapeout,*) '***  ATTENTION !! grossismx < 1 .   *** '
-         STOP
-      ELSE
-         alphax = 1. - 1./ grossismx
-      ENDIF
-
-      IF( grossismy.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
-         STOP
-      ELSE
-         alphay = 1. - 1./ grossismy
-      ENDIF
-
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    fxyhypb
-      WRITE(tapeout,9001) ch1,'fxyhypb'
-      WRITE(tapeout,*)    fxyhypb
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomx
-      WRITE(tapeout,9001) ch1,'dzoomx'
-      WRITE(tapeout,*)    dzoomx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomy
-      WRITE(tapeout,9001) ch1,'dzoomy'
-      WRITE(tapeout,*)    dzoomy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    taux
-      WRITE(tapeout,9001) ch1,'taux'
-      WRITE(tapeout,*)    taux
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauy
-      WRITE(tapeout,9001) ch1,'tauy'
-      WRITE(tapeout,*)    tauy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ysinus
-      WRITE(tapeout,9001) ch1,'ysinus'
-      WRITE(tapeout,*)    ysinus
-       
-      WRITE(tapeout,*) ' alphax alphay defrun ',alphax,alphay
-c
-9000  FORMAT(3(/,a72))
-9001  FORMAT(/,a72,/,a12)
-cc
-      CLOSE(tapedef)
-
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/fyhyp.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/fyhyp.F	(revision 1943)
+++ 	(revision )
@@ -1,378 +1,0 @@
-!
-! $Id: fyhyp.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-c
-c
-       SUBROUTINE fyhyp ( yzoomdeg, grossism, dzooma,tau  ,  
-     ,  rrlatu,yyprimu,rrlatv,yyprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
-     ,  champmin,champmax                                            ) 
-
-cc    ...  Version du 01/04/2001 ....
-
-       IMPLICIT NONE
-c
-c    ...   Auteur :  P. Le Van  ... 
-c
-c    .......    d'apres  formulations  de R. Sadourny  .......
-c
-c     Calcule les latitudes et derivees dans la grille du GCM pour une
-c     fonction f(y) a tangente  hyperbolique  .
-c
-c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois , etc)
-c     dzoom  etant  la distance totale de la zone du zoom ( en radians )
-c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom   
-c
-c
-c N.B : Il vaut mieux avoir : grossism * dzoom  <  pi/2  (radians) ,en lati.
-c      ********************************************************************
-c
-c
-#include "dimensions.h"
-#include "paramet.h"
-
-       INTEGER      nmax , nmax2
-       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
-c
-c
-c     .......  arguments  d'entree    .......
-c
-       REAL yzoomdeg, grossism,dzooma,tau 
-c         ( rentres  par  run.def )
-
-c     .......  arguments  de sortie   .......
-c
-       REAL rrlatu(jjp1), yyprimu(jjp1),rrlatv(jjm), yyprimv(jjm),
-     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
-
-c
-c     .....     champs  locaux    .....
-c
-     
-       REAL   dzoom
-       REAL(KIND=8) ylat(jjp1), yprim(jjp1)
-       REAL(KIND=8) yuv
-       REAL(KIND=8) yt(0:nmax2)
-       REAL(KIND=8) fhyp(0:nmax2),beta,Ytprim(0:nmax2),fxm(0:nmax2)
-       SAVE Ytprim, yt,Yf
-       REAL(KIND=8) Yf(0:nmax2),yypr(0:nmax2)
-       REAL(KIND=8) yvrai(jjp1), yprimm(jjp1),ylatt(jjp1)
-       REAL(KIND=8) pi,depi,pis2,epsilon,y0,pisjm
-       REAL(KIND=8) yo1,yi,ylon2,ymoy,Yprimin,champmin,champmax
-       REAL(KIND=8) yfi,Yf1,ffdy
-       REAL(KIND=8) ypn,deply,y00
-       SAVE y00, deply
-
-       INTEGER i,j,it,ik,iter,jlat
-       INTEGER jpn,jjpn
-       SAVE jpn
-       REAL(KIND=8) a0,a1,a2,a3,yi2,heavyy0,heavyy0m
-       REAL(KIND=8) fa(0:nmax2),fb(0:nmax2)
-       REAL y0min,y0max
-
-       REAL(KIND=8)     heavyside
-
-       pi       = 2. * ASIN(1.)
-       depi     = 2. * pi
-       pis2     = pi/2.
-       pisjm    = pi/ REAL(jjm)
-       epsilon  = 1.e-3
-       y0       =  yzoomdeg * pi/180. 
-
-       IF( dzooma.LT.1.)  THEN
-         dzoom = dzooma * pi
-       ELSEIF( dzooma.LT. 12. ) THEN
-         WRITE(6,*) ' Le param. dzoomy pour fyhyp est trop petit ! L aug
-     ,menter et relancer ! '
-         STOP 1
-       ELSE
-         dzoom = dzooma * pi/180.
-       ENDIF
-
-       WRITE(6,18)
-       WRITE(6,*) ' yzoom( rad.),grossism,tau,dzoom (radians)'
-       WRITE(6,24) y0,grossism,tau,dzoom
-
-       DO i = 0, nmax2 
-        yt(i) = - pis2  + REAL(i)* pi /nmax2
-       ENDDO
-
-       heavyy0m = heavyside( -y0 )
-       heavyy0  = heavyside(  y0 )
-       y0min    = 2.*y0*heavyy0m - pis2
-       y0max    = 2.*y0*heavyy0  + pis2
-
-       fa = 999.999
-       fb = 999.999
-       
-       DO i = 0, nmax2 
-        IF( yt(i).LT.y0 )  THEN
-         fa (i) = tau*  (yt(i)-y0+dzoom/2. )
-         fb(i) =   (yt(i)-2.*y0*heavyy0m +pis2) * ( y0 - yt(i) )
-        ELSEIF ( yt(i).GT.y0 )  THEN
-         fa(i) =   tau *(y0-yt(i)+dzoom/2. )
-         fb(i) = (2.*y0*heavyy0 -yt(i)+pis2) * ( yt(i) - y0 ) 
-       ENDIF
-        
-       IF( 200.* fb(i) .LT. - fa(i) )   THEN
-         fhyp ( i) = - 1.
-       ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
-         fhyp ( i) =   1.
-       ELSE  
-         fhyp(i) =  TANH ( fa(i)/fb(i) )
-       ENDIF
-
-       IF( yt(i).EQ.y0 )  fhyp(i) = 1.
-       IF(yt(i).EQ. y0min. OR.yt(i).EQ. y0max ) fhyp(i) = -1.
-
-       ENDDO
-
-cc  ....  Calcul  de  beta  ....
-c
-       ffdy   = 0.
-
-       DO i = 1, nmax2
-        ymoy    = 0.5 * ( yt(i-1) + yt( i ) )
-        IF( ymoy.LT.y0 )  THEN
-         fa(i)= tau * ( ymoy-y0+dzoom/2.) 
-         fb(i) = (ymoy-2.*y0*heavyy0m +pis2) * ( y0 - ymoy )
-        ELSEIF ( ymoy.GT.y0 )  THEN
-         fa(i)= tau * ( y0-ymoy+dzoom/2. ) 
-         fb(i) = (2.*y0*heavyy0 -ymoy+pis2) * ( ymoy - y0 )
-        ENDIF
-
-        IF( 200.* fb(i) .LT. - fa(i) )    THEN
-         fxm ( i) = - 1.
-        ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
-         fxm ( i) =   1.
-        ELSE
-         fxm(i) =  TANH ( fa(i)/fb(i) )
-        ENDIF
-         IF( ymoy.EQ.y0 )  fxm(i) = 1.
-         IF (ymoy.EQ. y0min. OR.yt(i).EQ. y0max ) fxm(i) = -1.
-         ffdy = ffdy + fxm(i) * ( yt(i) - yt(i-1) )
-
-        ENDDO
-
-        beta  = ( grossism * ffdy - pi ) / ( ffdy - pi )
-
-       IF( 2.*beta - grossism.LE. 0.)  THEN
-
-        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
-     ,tine fyhyp est mauvaise ! '
-        WRITE(6,*)'Modifier les valeurs de  grossismy ,tauy ou dzoomy',
-     , ' et relancer ! ***  '
-        CALL ABORT
-
-       ENDIF
-c
-c   .....  calcul  de  Ytprim   .....
-c
-       
-       DO i = 0, nmax2
-        Ytprim(i) = beta  + ( grossism - beta ) * fhyp(i)
-       ENDDO
-
-c   .....  Calcul  de  Yf     ........
-
-       Yf(0) = - pis2
-       DO i = 1, nmax2
-        yypr(i)    = beta + ( grossism - beta ) * fxm(i)
-       ENDDO
-
-       DO i=1,nmax2
-        Yf(i)   = Yf(i-1) + yypr(i) * ( yt(i) - yt(i-1) )
-       ENDDO
-
-c    ****************************************************************
-c
-c   .....   yuv  = 0.   si calcul des latitudes  aux pts.  U  .....
-c   .....   yuv  = 0.5  si calcul des latitudes  aux pts.  V  .....
-c
-      WRITE(6,18)
-c
-      DO 5000  ik = 1,4
-
-       IF( ik.EQ.1 )  THEN
-         yuv  = 0.
-         jlat = jjm + 1
-       ELSE IF ( ik.EQ.2 )  THEN
-         yuv  = 0.5
-         jlat = jjm 
-       ELSE IF ( ik.EQ.3 )  THEN
-         yuv  = 0.25
-         jlat = jjm 
-       ELSE IF ( ik.EQ.4 )  THEN
-         yuv  = 0.75
-         jlat = jjm 
-       ENDIF
-c
-       yo1   = 0.
-       DO 1500 j =  1,jlat
-        yo1   = 0.
-        ylon2 =  - pis2 + pisjm * ( REAL(j)  + yuv  -1.)  
-        yfi    = ylon2
-c
-       DO 250 it =  nmax2,0,-1
-        IF( yfi.GE.Yf(it))  GO TO 350
-250    CONTINUE
-       it = 0
-350    CONTINUE
-
-       yi = yt(it)
-       IF(it.EQ.nmax2)  THEN
-        it       = nmax2 -1
-        Yf(it+1) = pis2
-       ENDIF
-c  .................................................................
-c  ....  Interpolation entre  yi(it) et yi(it+1)   pour avoir Y(yi)  
-c      .....           et   Y'(yi)                             .....
-c  .................................................................
-
-       CALL coefpoly ( Yf(it),Yf(it+1),Ytprim(it), Ytprim(it+1),   
-     ,                  yt(it),yt(it+1) ,   a0,a1,a2,a3   )      
-
-       Yf1     = Yf(it)
-       Yprimin = a1 + 2.* a2 * yi + 3.*a3 * yi *yi
-
-       DO 500 iter = 1,300
-         yi = yi - ( Yf1 - yfi )/ Yprimin
-
-        IF( ABS(yi-yo1).LE.epsilon)  GO TO 550
-         yo1      = yi
-         yi2      = yi * yi
-         Yf1      = a0 +  a1 * yi +     a2 * yi2  +     a3 * yi2 * yi
-         Yprimin  =       a1      + 2.* a2 *  yi  + 3.* a3 * yi2
-500   CONTINUE
-        WRITE(6,*) ' Pas de solution ***** ',j,ylon2,iter
-         STOP 2
-550   CONTINUE
-c
-       Yprimin   = a1  + 2.* a2 *  yi   + 3.* a3 * yi* yi
-       yprim(j)  = pi / ( jjm * Yprimin )
-       yvrai(j)  = yi 
-
-1500    CONTINUE
-
-       DO j = 1, jlat -1
-        IF( yvrai(j+1). LT. yvrai(j) )  THEN
-         WRITE(6,*) ' PBS. avec  rlat(',j+1,') plus petit que rlat(',j,
-     ,  ')'
-         STOP 3
-        ENDIF
-       ENDDO
-
-       WRITE(6,*) 'Reorganisation des latitudes pour avoir entre - pi/2'
-     , ,' et  pi/2 '
-c
-        IF( ik.EQ.1 )   THEN
-           ypn = pis2 
-          DO j = jlat,1,-1
-           IF( yvrai(j).LE. ypn ) GO TO 1502
-          ENDDO
-1502     CONTINUE
-
-         jpn   = j
-         y00   = yvrai(jpn)
-         deply = pis2 -  y00
-        ENDIF
-
-         DO  j = 1, jjm +1 - jpn
-           ylatt (j)  = -pis2 - y00  + yvrai(jpn+j-1)
-           yprimm(j)  = yprim(jpn+j-1)
-         ENDDO
-
-         jjpn  = jpn
-         IF( jlat.EQ. jjm ) jjpn = jpn -1
-
-         DO j = 1,jjpn 
-          ylatt (j + jjm+1 -jpn) = yvrai(j) + deply
-          yprimm(j + jjm+1 -jpn) = yprim(j)
-         ENDDO
-
-c      ***********   Fin de la reorganisation     *************
-c
- 1600   CONTINUE
-
-       DO j = 1, jlat
-          ylat(j) =  ylatt( jlat +1 -j )
-         yprim(j) = yprimm( jlat +1 -j )
-       ENDDO
-  
-        DO j = 1, jlat
-         yvrai(j) = ylat(j)*180./pi
-        ENDDO
-
-        IF( ik.EQ.1 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT  en U   apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rrlatu(j) =  ylat( j )
-           yyprimu(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 2 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*) ' YLAT   en V  apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*)' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rrlatv(j) =  ylat( j )
-           yyprimv(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 3 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT  en U + 0.75  apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rlatu2(j) =  ylat( j )
-           yprimu2(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 4 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT en U + 0.25  apres ( en  deg. ) '
-c         WRITE(6,68)(yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,68) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rlatu1(j) =  ylat( j )
-           yprimu1(j) = yprim( j )
-          ENDDO
-
-        ENDIF
-
-5000   CONTINUE
-c
-        WRITE(6,18)
-c
-c  .....     fin de la boucle  do 5000 .....
-
-        DO j = 1, jjm
-         ylat(j) = rrlatu(j) - rrlatu(j+1)
-        ENDDO
-        champmin =  1.e12
-        champmax = -1.e12
-        DO j = 1, jjm
-         champmin = MIN( champmin, ylat(j) )
-         champmax = MAX( champmax, ylat(j) )
-        ENDDO
-         champmin = champmin * 180./pi
-         champmax = champmax * 180./pi
-
-24     FORMAT(2x,'Parametres yzoom,gross,tau ,dzoom pour fyhyp ',4f8.3)
-18      FORMAT(/)
-68      FORMAT(1x,7f9.2)
-
-        RETURN
-        END
Index: LMDZ5/trunk/libf/dyn3dmem/grid_atob.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/grid_atob.F	(revision 1943)
+++ 	(revision )
@@ -1,971 +1,0 @@
-!
-! $Id: grid_atob.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie)
-c=======================================================================
-c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
-c
-c Methode naive pour transformer un champ d'une grille fine a une
-c grille grossiere. Je considere que les nouveaux points occupent
-c une zone adjacente qui comprend un ou plusieurs anciens points
-c
-c Aucune ponderation est consideree (voir grille_p)
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        sortie: champ de sortie deja transforme
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL number(2200,1100)
-      REAL distans(2200*1100)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-c
-c Calculer les limites des zones des nouveaux points
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c Determiner la zone sur laquelle chaque ancien point se trouve
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               number(ii,jj) = number(ii,jj) + 1.0
-               sortie(ii,jj) = sortie(ii,jj) + entree(i,j)
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c Si aucun ancien point tombe sur une zone, c'est un probleme
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (number(i,j) .GT. 0.001) THEN
-         sortie(i,j) = sortie(i,j) / number(i,j)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-ccc         CALL ABORT
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         sortie(i,j) = entree(i_proche,j_proche)
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-      SUBROUTINE grille_p(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie)
-c=======================================================================
-c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
-c
-c Methode naive pour transformer un champ d'une grille fine a une
-c grille grossiere. Je considere que les nouveaux points occupent
-c une zone adjacente qui comprend un ou plusieurs anciens points
-c
-c Consideration de la distance des points (voir grille_m)
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        sortie: champ de sortie deja transforme
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(200),d(200)
-      REAL number(400,200)
-      INTEGER indx(400,200), indy(400,200)
-      REAL dist(400,200), distsom(400,200)
-c
-      IF (imar.GT.400 .OR. jmar.GT.200) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-c
-      IF (imdep.GT.400 .OR. jmdep.GT.200) THEN
-         PRINT*, 'imdep ou jmdep trop grand', imdep, jmdep
-         CALL ABORT
-      ENDIF
-c
-c calculer les bords a et b de la nouvelle grille
-c
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-c
-c calculer les bords c et d de la nouvelle grille
-c
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-c
-c trouver les indices (indx,indy) de la nouvelle grille sur laquelle
-c un point de l'ancienne grille est tombe.
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               indx(i,j) = ii
-               indy(i,j) = jj
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c faire une verification
-c
-
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         IF (indx(i,j).GT.imar .OR. indy(i,j).GT.jmar) THEN
-            PRINT*, 'Probleme grave,i,j,indx,indy=',
-     .              i,j,indx(i,j),indy(i,j)
-            CALL abort
-         ENDIF
-      ENDDO
-      ENDDO
-
-c
-c calculer la distance des anciens points avec le nouveau point,
-c on prend ensuite une sorte d'inverse pour ponderation.
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         distsom(i,j) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         dist(i,j) = SQRT ( (xdata(i)-x(indx(i,j)))**2
-     .                     +(ydata(j)-y(indy(i,j)))**2 )
-         distsom(indx(i,j),indy(i,j)) = distsom(indx(i,j),indy(i,j))
-     .                                  + dist(i,j)
-         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j)) +1.
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         dist(i,j) = 1.0 - dist(i,j)/distsom(indx(i,j),indy(i,j))
-      ENDDO
-      ENDDO
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         sortie(indx(i,j),indy(i,j)) = sortie(indx(i,j),indy(i,j))
-     .                                 + entree(i,j) * dist(i,j)
-         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j))
-     .                                 + dist(i,j)
-      ENDDO
-      ENDDO
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (number(i,j) .GT. 0.001) THEN
-         sortie(i,j) = sortie(i,j) / number(i,j)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-
-      SUBROUTINE mask_c_o(imdep, jmdep, xdata, ydata, relief,
-     .                    imar, jmar, x, y, mask)
-c=======================================================================
-c z.x.li (le 1 avril 1994): A partir du champ de relief, on fabrique
-c                           un champ indicateur (masque) terre/ocean
-c                           terre:1; ocean:0
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL relief(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL mask(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL num_tot(2200,1100), num_oce(2200,1100)
-c
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_oce(i,j) = 0.0
-         num_tot(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-               IF (.NOT. ( relief(i,j) - 0.9. GE. 1.e-5 ) )
-     .             num_oce(ii,jj) = num_oce(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-c
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (num_tot(i,j) .GT. 0.001) THEN
-           IF ( num_oce(i,j)/num_tot(i,j) - 0.5 .GE. 1.e-5 ) THEN
-              mask(i,j) = 0.
-           ELSE
-              mask(i,j) = 1.
-           ENDIF
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-c
-c
-
-
-      SUBROUTINE rugosite(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie, mask)
-c=======================================================================
-c z.x.li (le 1 avril 1994): Transformer la longueur de rugosite d'une
-c grille fine a une grille grossiere. Sur l'ocean, on impose une valeur
-c fixe (0.001m).
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar), mask(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(400),d(400)
-      REAL num_tot(400,400)
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      IF (imar.GT.400 .OR. jmar.GT.400) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_tot(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              sortie(ii,jj)  = sortie(ii,jj) + LOG(entree(i,j))
-              num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-       IF (NINT(mask(i,j)).EQ.1) THEN
-         IF (num_tot(i,j) .GT. 0.0) THEN
-            sortie(i,j) = sortie(i,j) / num_tot(i,j)
-            sortie(i,j) = EXP(sortie(i,j))
-         ELSE
-            PRINT*, 'probleme,i,j=', i,j
-ccc            CALL ABORT
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         sortie(i,j) = entree(i_proche,j_proche)
-         ENDIF
-       ELSE
-         sortie(i,j) = 0.001
-       ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-
-
-      SUBROUTINE sea_ice(imdep, jmdep, xdata, ydata, glace01,
-     .                    imar, jmar, x, y, frac_ice)
-c=======================================================================
-c z.x.li (le 1 avril 1994): Transformer un champ d'indicateur de la
-c glace (1, sinon 0) d'une grille fine a un champ de fraction de glace
-c (entre 0 et 1) dans une grille plus grossiere.
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL glace01(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL frac_ice(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(400),d(400)
-      REAL num_tot(400,400), num_ice(400,400)
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      IF (imar.GT.400 .OR. jmar.GT.400) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_ice(i,j) = 0.0
-         num_tot(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-             num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-              IF (NINT(glace01(i,j)).EQ.1 ) 
-     .       num_ice(ii,jj) = num_ice(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (num_tot(i,j) .GT. 0.001) THEN
-           IF (num_ice(i,j).GT.0.001) THEN
-            frac_ice(i,j) = num_ice(i,j) / num_tot(i,j)
-           ELSE
-              frac_ice(i,j) = 0.0
-           ENDIF
-         ELSE
-           PRINT*, 'probleme,i,j=', i,j
-ccc           CALL ABORT
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         IF (NINT(glace01(i_proche,j_proche)).EQ.1 ) THEN
-            frac_ice(i,j) = 1.0
-         ELSE
-            frac_ice(i,j) = 0.0
-         ENDIF
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-      SUBROUTINE rugsoro(imrel, jmrel, xrel, yrel, relief,
-     .                    immod, jmmod, xmod, ymod, rugs)
-c=======================================================================
-c Calculer la longueur de rugosite liee au relief en utilisant
-c l'ecart-type dans une maille de 1x1
-C=======================================================================
-      IMPLICIT none
-c
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      REAL amin, AMAX
-c
-      INTEGER imrel, jmrel
-      REAL xrel(imrel),yrel(jmrel)
-      REAL relief(imrel,jmrel)
-c
-      INTEGER immod, jmmod
-      REAL xmod(immod),ymod(jmmod)
-      REAL rugs(immod,jmmod)
-c
-      INTEGER imtmp, jmtmp
-      PARAMETER (imtmp=360,jmtmp=180)
-      REAL xtmp(imtmp), ytmp(jmtmp)
-      REAL(KIND=8) cham1tmp(imtmp,jmtmp), cham2tmp(imtmp,jmtmp)
-      REAL zzzz
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL number(2200,1100)
-c
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-c
-      IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN
-         PRINT*, 'immod ou jmmod trop grand', immod, jmmod
-         CALL ABORT
-      ENDIF
-c
-c Calculs intermediares:
-c
-      xtmp(1) = -180.0 + 360.0/REAL(imtmp) / 2.0
-      DO i = 2, imtmp
-         xtmp(i) = xtmp(i-1) + 360.0/REAL(imtmp)
-      ENDDO
-      DO i = 1, imtmp
-         xtmp(i) = xtmp(i) /180.0 * 4.0*ATAN(1.0)
-      ENDDO
-      ytmp(1) = -90.0 + 180.0/REAL(jmtmp) / 2.0
-      DO j = 2, jmtmp
-         ytmp(j) = ytmp(j-1) + 180.0/REAL(jmtmp)
-      ENDDO
-      DO j = 1, jmtmp
-         ytmp(j) = ytmp(j) /180.0 * 4.0*ATAN(1.0)
-      ENDDO
-c
-      a(1) = xtmp(1) - (xtmp(2)-xtmp(1))/2.0
-      b(1) = (xtmp(1)+xtmp(2))/2.0
-      DO i = 2, imtmp-1
-         a(i) = b(i-1)
-         b(i) = (xtmp(i)+xtmp(i+1))/2.0
-      ENDDO
-      a(imtmp) = b(imtmp-1)
-      b(imtmp) = xtmp(imtmp) + (xtmp(imtmp)-xtmp(imtmp-1))/2.0
-
-      c(1) = ytmp(1) - (ytmp(2)-ytmp(1))/2.0
-      d(1) = (ytmp(1)+ytmp(2))/2.0
-      DO j = 2, jmtmp-1
-         c(j) = d(j-1)
-         d(j) = (ytmp(j)+ytmp(j+1))/2.0
-      ENDDO
-      c(jmtmp) = d(jmtmp-1)
-      d(jmtmp) = ytmp(jmtmp) + (ytmp(jmtmp)-ytmp(jmtmp-1))/2.0
-
-      DO i = 1, imtmp
-      DO j = 1, jmtmp
-         number(i,j) = 0.0
-         cham1tmp(i,j) = 0.0
-         cham2tmp(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imtmp
-      DO jj = 1, jmtmp
-        DO i = 1, imrel
-         IF( ( xrel(i)-a(ii).GE.1.e-5.AND.xrel(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xrel(i)-a(ii).LE.1.e-5.AND.xrel(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmrel
-          IF( (yrel(j)-c(jj).GE.1.e-5.AND.yrel(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  yrel(j)-c(jj).LE.1.e-5.AND.yrel(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              number(ii,jj) = number(ii,jj) + 1.0
-              cham1tmp(ii,jj) = cham1tmp(ii,jj) + relief(i,j)
-              cham2tmp(ii,jj) = cham2tmp(ii,jj) 
-     .                              + relief(i,j)*relief(i,j)
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-      DO i = 1, imtmp
-      DO j = 1, jmtmp
-         IF (number(i,j) .GT. 0.001) THEN
-         cham1tmp(i,j) = cham1tmp(i,j) / number(i,j)
-         cham2tmp(i,j) = cham2tmp(i,j) / number(i,j)
-         zzzz=cham2tmp(i,j)-cham1tmp(i,j)**2
-         if (zzzz .lt. 0.0) then
-           if (zzzz .gt. -7.5) then
-             zzzz = 0.0
-             print*,'Pb rugsoro, -7.5 < zzzz < 0, => zzz = 0.0'
-           else
-              stop 'Pb rugsoro, zzzz <-7.5'
-           endif
-         endif
-         cham2tmp(i,j) = SQRT(zzzz)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT
-         ENDIF
-      ENDDO
-      ENDDO
-c
-      amin = cham2tmp(1,1)
-      AMAX = cham2tmp(1,1)
-      DO j = 1, jmtmp
-      DO i = 1, imtmp
-         IF (cham2tmp(i,j).GT.AMAX) AMAX = cham2tmp(i,j)
-         IF (cham2tmp(i,j).LT.amin) amin = cham2tmp(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Ecart-type 1x1:', amin, AMAX
-c
-c
-c
-      a(1) = xmod(1) - (xmod(2)-xmod(1))/2.0
-      b(1) = (xmod(1)+xmod(2))/2.0
-      DO i = 2, immod-1
-         a(i) = b(i-1)
-         b(i) = (xmod(i)+xmod(i+1))/2.0
-      ENDDO
-      a(immod) = b(immod-1)
-      b(immod) = xmod(immod) + (xmod(immod)-xmod(immod-1))/2.0
-
-      c(1) = ymod(1) - (ymod(2)-ymod(1))/2.0
-      d(1) = (ymod(1)+ymod(2))/2.0
-      DO j = 2, jmmod-1
-         c(j) = d(j-1)
-         d(j) = (ymod(j)+ymod(j+1))/2.0
-      ENDDO
-      c(jmmod) = d(jmmod-1)
-      d(jmmod) = ymod(jmmod) + (ymod(jmmod)-ymod(jmmod-1))/2.0
-c
-      DO i = 1, immod
-      DO j = 1, jmmod
-         number(i,j) = 0.0
-         rugs(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, immod
-      DO jj = 1, jmmod
-        DO i = 1, imtmp
-         IF( ( xtmp(i)-a(ii).GE.1.e-5.AND.xtmp(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xtmp(i)-a(ii).LE.1.e-5.AND.xtmp(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmtmp
-          IF( (ytmp(j)-c(jj).GE.1.e-5.AND.ytmp(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ytmp(j)-c(jj).LE.1.e-5.AND.ytmp(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              number(ii,jj) = number(ii,jj) + 1.0
-              rugs(ii,jj) = rugs(ii,jj)
-     .                       + LOG(MAX(0.001_8,cham2tmp(i,j)))
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-      DO i = 1, immod
-      DO j = 1, jmmod
-         IF (number(i,j) .GT. 0.001) THEN
-         rugs(i,j) = rugs(i,j) / number(i,j)
-         rugs(i,j) = EXP(rugs(i,j))
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-ccc         CALL ABORT
-         CALL dist_sphe(xmod(i),ymod(j),xtmp,ytmp,imtmp,jmtmp,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imtmp*jmtmp,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imtmp*jmtmp
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imtmp + 1
-         i_proche = ij_proche - (j_proche-1)*imtmp
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         rugs(i,j) = LOG(MAX(0.001_8,cham2tmp(i_proche,j_proche)))
-         ENDIF
-      ENDDO
-      ENDDO
-c
-      amin = rugs(1,1)
-      AMAX = rugs(1,1)
-      DO j = 1, jmmod
-      DO i = 1, immod
-         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
-         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Ecart-type du modele:', amin, AMAX
-c
-      DO j = 1, jmmod
-      DO i = 1, immod
-         rugs(i,j) = rugs(i,j) / AMAX * 20.0
-      ENDDO
-      ENDDO
-c
-      amin = rugs(1,1)
-      AMAX = rugs(1,1)
-      DO j = 1, jmmod
-      DO i = 1, immod
-         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
-         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Longueur de rugosite du modele:', amin, AMAX
-c
-      RETURN
-      END
-c
-      SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,im,jm,distance)
-c
-c Auteur: Laurent Li (le 30 decembre 1996)
-c
-c Ce programme calcule la distance minimale (selon le grand cercle)
-c entre deux points sur la terre
-c
-c Input:
-      INTEGER im, jm ! dimensions
-      REAL rf_lon ! longitude du point de reference (degres)
-      REAL rf_lat ! latitude du point de reference (degres)
-      REAL rlon(im), rlat(jm) ! longitude et latitude des points
-c
-c Output:
-      REAL distance(im,jm) ! distances en metre
-c
-      REAL rlon1, rlat1
-      REAL rlon2, rlat2
-      REAL dist
-      REAL pa, pb, p, pi
-c
-      REAL radius
-      PARAMETER (radius=6371229.)
-c
-      pi = 4.0 * ATAN(1.0)
-c
-      DO 9999 j = 1, jm
-      DO 9999 i = 1, im
-c
-      rlon1=rf_lon
-      rlat1=rf_lat
-      rlon2=rlon(i)
-      rlat2=rlat(j)
-      pa = pi/2.0 - rlat1*pi/180.0 ! dist. entre pole n et point a
-      pb = pi/2.0 - rlat2*pi/180.0 ! dist. entre pole n et point b
-      p = (rlon1-rlon2)*pi/180.0 ! angle entre a et b (leurs meridiens)
-c
-      dist = ACOS( COS(pa)*COS(pb) + SIN(pa)*SIN(pb)*COS(p))
-      dist = radius * dist
-      distance(i,j) = dist
-c
- 9999 CONTINUE
-c
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/grid_noro.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/grid_noro.F	(revision 1943)
+++ 	(revision )
@@ -1,521 +1,0 @@
-!
-! $Id$
-!
-c
-c
-      SUBROUTINE grid_noro(imdep, jmdep, xdata, ydata, zdata,
-     .             imar, jmar, x, y,
-     .             zphi,zmea,zstd,zsig,zgam,zthe,
-     .             zpic,zval,mask)
-c=======================================================================
-c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
-c
-c      Compute the Parameters of the SSO scheme as described in
-c      LOTT & MILLER (1997) and LOTT(1999).
-c      Target points are on a rectangular grid:
-c      iim+1 latitudes including North and South Poles;
-c      jjm+1 longitudes, with periodicity jjm+1=1.
-c      aux poles.  At the poles the fields value is repeated
-c      jjm+1 time.
-c      The parameters a,b,c,d represent the limite of the target
-c      gridpoint region. The means over this region are calculated
-c      from USN data, ponderated by a weight proportional to the 
-c      surface occupated by the data inside the model gridpoint area.
-c      In most circumstances, this weight is the ratio between the
-c      surface of the USN gridpoint area and the surface of the
-c      model gridpoint area. 
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X and Y input field
-c        xdata, ydata: coordinates X and Y input field
-c        zdata: Input field
-c        In this version it is assumed that the entry data come from
-c        the USNavy dataset: imdep=iusn=2160, jmdep=jusn=1080.
-c OUTPUT:
-c        imar, jmar: dimensions X and Y Output field
-c        x, y: ccordinates  X and Y Output field.
-c             zmea:  Mean orographie   
-c             zstd:  Standard deviation
-c             zsig:  Slope
-c             zgam:  Anisotropy
-c             zthe:  Orientation of the small axis
-c             zpic:  Maximum altitude
-c             zval:  Minimum altitude
-C=======================================================================
-
-      IMPLICIT INTEGER (I,J)
-      IMPLICIT REAL(X,Z) 
-      
-	  parameter(iusn=2160,jusn=1080,iext=216, epsfra = 1.e-5)
-#include "dimensions.h"
-	  REAL xusn(iusn+2*iext),yusn(jusn+2)	
-      REAL zusn(iusn+2*iext,jusn+2)
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL zdata(imdep,jmdep)
-c
-      INTEGER imar, jmar
-  
-C INTERMEDIATE FIELDS  (CORRELATIONS OF OROGRAPHY GRADIENT)
-
-      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
-      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
-      REAL weight(iim+1,jjm+1)
-
-C CORRELATIONS OF USN OROGRAPHY GRADIENTS
-
-      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
-      REAL zxtzyusn(iusn+2*iext,jusn+2)
-      REAL x(imar+1),y(jmar),zphi(imar+1,jmar)
-      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
-      REAL zmea0(imar+1,jmar) ! GK211005 (CG)
-      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
-      REAL zpic(imar+1,jmar),zval(imar+1,jmar)
-cxxx PB     integer mask(imar+1,jmar)
-      real mask(imar+1,jmar), mask_tmp(imar+1,jmar)
-      real num_tot(2200,1100),num_lan(2200,1100)
-c
-      REAL a(2200),b(2200),c(1100),d(1100)
-      logical masque_lu
-c
-      print *,' parametres de l orographie a l echelle sous maille' 
-      xpi=acos(-1.)
-      rad    = 6 371 229.
-      zdeltay=2.*xpi/REAL(jusn)*rad
-c
-c utilise-t'on un masque lu?
-c
-      masque_lu = .true.
-      if (maxval(mask) == -99999 .and. minval(mask) == -99999) then
-        masque_lu= .false.
-        masque = 0.0
-      endif
-      write(*,*)'Masque lu', masque_lu
-c
-c  quelques tests de dimensions:
-c    
-c
-      if(iim.ne.imar) STOP 'Problem dim. x'
-      if(jjm.ne.jmar-1) STOP 'Problem dim. y'
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar or jmar too big', imar, jmar
-         CALL ABORT
-      ENDIF
-
-      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
-         print *,' imdep or jmdep bad dimensions:',imdep,jmdep
-         call abort
-      ENDIF
-
-      IF(imar+1.ne.iim+1.or.jmar.ne.jjm+1)THEN
-        print *,' imar or jmar bad dimensions:',imar,jmar
-        call abort
-      ENDIF
-
-
-c      print *,'xdata:',xdata
-c      print *,'ydata:',ydata
-c      print *,'x:',x
-c      print *,'y:',y
-c
-C  EXTENSION OF THE USN DATABASE TO POCEED COMPUTATIONS AT
-C  BOUNDARIES:
-c
-      DO j=1,jusn
-        yusn(j+1)=ydata(j)
-      DO i=1,iusn
-        zusn(i+iext,j+1)=zdata(i,j)
-        xusn(i+iext)=xdata(i)
-      ENDDO
-      DO i=1,iext
-        zusn(i,j+1)=zdata(iusn-iext+i,j)
-        xusn(i)=xdata(iusn-iext+i)-2.*xpi
-        zusn(iusn+iext+i,j+1)=zdata(i,j)
-        xusn(iusn+iext+i)=xdata(i)+2.*xpi
-      ENDDO
-      ENDDO
-
-        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
-        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
-       DO i=1,iusn/2+iext
-        zusn(i,1)=zusn(i+iusn/2,2)
-        zusn(i+iusn/2+iext,1)=zusn(i,2)
-        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
-        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
-       ENDDO
-c  
-c COMPUTE LIMITS OF MODEL GRIDPOINT AREA
-C     ( REGULAR GRID)
-c
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar+1) = b(imar)
-      b(imar+1) = x(imar+1) + (x(imar+1)-x(imar))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-c
-c  initialisations:
-c
-      DO i = 1, imar+1
-      DO j = 1, jmar
-         weight(i,j) = 0.0
-         zxtzx(i,j)  = 0.0
-         zytzy(i,j)  = 0.0
-         zxtzy(i,j)  = 0.0
-         ztz(i,j)    = 0.0
-         zmea(i,j)   = 0.0
-         zpic(i,j)  =-1.E+10
-         zval(i,j)  = 1.E+10
-      ENDDO
-      ENDDO
-c
-c  COMPUTE SLOPES CORRELATIONS ON USN GRID
-c
-         DO j = 1,jusn+2 
-         DO i = 1, iusn+2*iext
-            zytzyusn(i,j)=0.0
-            zxtzxusn(i,j)=0.0
-            zxtzyusn(i,j)=0.0
-         ENDDO
-         ENDDO
-
-
-         DO j = 2,jusn+1 
-            zdeltax=zdeltay*cos(yusn(j))
-         DO i = 2, iusn+2*iext-1
-            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
-            zxtzxusn(i,j)=(zusn(i+1,j)-zusn(i-1,j))**2/zdeltax**2
-            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
-     *                   *(zusn(i+1,j)-zusn(i-1,j))/zdeltax
-         ENDDO
-         ENDDO
-c
-c  SUMMATION OVER GRIDPOINT AREA
-c 
-      zleny=xpi/REAL(jusn)*rad
-      xincr=xpi/2./REAL(jusn)
-       DO ii = 1, imar+1
-       DO jj = 1, jmar
-       num_tot(ii,jj)=0.
-       num_lan(ii,jj)=0.
-c        PRINT *,' iteration ii jj:',ii,jj
-         DO j = 2,jusn+1 
-c         DO j = 3,jusn 
-            zlenx=zleny*cos(yusn(j))
-            zdeltax=zdeltay*cos(yusn(j))
-            zbordnor=(c(jj)-yusn(j)+xincr)*rad
-            zbordsud=(yusn(j)-d(jj)+xincr)*rad
-            weighy=AMAX1(0.,
-     *             amin1(zbordnor,zbordsud,zleny))
-         IF(weighy.ne.0)THEN
-         DO i = 2, iusn+2*iext-1
-            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
-            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
-            weighx=AMAX1(0.,
-     *             amin1(zbordest,zbordoue,zlenx))
-            IF(weighx.ne.0)THEN
-            num_tot(ii,jj)=num_tot(ii,jj)+1.0
-            if(zusn(i,j).ge.1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
-            weight(ii,jj)=weight(ii,jj)+weighx*weighy
-            zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
-            zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
-            zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
-            ztz(ii,jj)  =ztz(ii,jj)  +zusn(i,j)*zusn(i,j)*weighx*weighy
-c mean
-            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
-c peacks
-            zpic(ii,jj)=amax1(zpic(ii,jj),zusn(i,j))
-c valleys
-            zval(ii,jj)=amin1(zval(ii,jj),zusn(i,j))
-            ENDIF
-         ENDDO
-         ENDIF
-         ENDDO
-       ENDDO
-       ENDDO
-c
-c  COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND
-C  LOTT (1999) SSO SCHEME.
-c
-      zllmmea=0.
-      zllmstd=0.
-      zllmsig=0.
-      zllmgam=0.
-      zllmpic=0.
-      zllmval=0.
-      zllmthe=0.
-      zminthe=0.
-c     print 100,' '
-c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
-       DO ii = 1, imar+1
-       DO jj = 1, jmar
-         IF (weight(ii,jj) .NE. 0.0) THEN
-c  Mask
-cXXX           if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
-cXXX             mask(ii,jj)=1
-cXXX           else
-cXXX             mask(ii,jj)=0
-cXXX           ENDIF
-             if (.not. masque_lu) then
-               mask(ii,jj) = num_lan(ii,jj)/num_tot(ii,jj)
-             endif
-c  Mean Orography:
-           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
-           zxtzx(ii,jj)=zxtzx(ii,jj)/weight(ii,jj)
-           zytzy(ii,jj)=zytzy(ii,jj)/weight(ii,jj)
-           zxtzy(ii,jj)=zxtzy(ii,jj)/weight(ii,jj)
-           ztz(ii,jj)  =ztz(ii,jj)/weight(ii,jj)
-c  Standard deviation:
-           zstd(ii,jj)=sqrt(AMAX1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
-         ELSE
-            PRINT*, 'probleme,ii,jj=', ii,jj
-         ENDIF
-       ENDDO
-       ENDDO
-
-C CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES:
-
-       DO ii = 1, imar+1
-         zxtzx(ii,1)=zxtzx(ii,2)
-         zxtzx(ii,jmar)=zxtzx(ii,jmar-1)
-         zxtzy(ii,1)=zxtzy(ii,2)
-         zxtzy(ii,jmar)=zxtzy(ii,jmar-1)
-         zytzy(ii,1)=zytzy(ii,2)
-         zytzy(ii,jmar)=zytzy(ii,jmar-1)
-       ENDDO
-
-C  FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME.
-
-C  FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
-
-       zmea0(:,:) = zmea(:,:) ! GK211005 (CG) on sauvegarde la topo non lissee
-       CALL MVA9(zmea,iim+1,jjm+1)
-       CALL MVA9(zstd,iim+1,jjm+1)
-       CALL MVA9(zpic,iim+1,jjm+1)
-       CALL MVA9(zval,iim+1,jjm+1)
-       CALL MVA9(zxtzx,iim+1,jjm+1)
-       CALL MVA9(zxtzy,iim+1,jjm+1) 
-       CALL MVA9(zytzy,iim+1,jjm+1)
-CXXX   Masque prenant en compte maximum de terre
-CXXX  On seuil a 10% de terre de terre car en dessous les parametres de surface n'on
-CXXX pas de sens (PB)
-       mask_tmp= 0.0
-       WHERE(mask .GE. 0.1) mask_tmp = 1.
-
-       DO ii = 1, imar
-       DO jj = 1, jmar
-         IF (weight(ii,jj) .NE. 0.0) THEN
-c  Coefficients K, L et M:
-           xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
-           xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
-           xm=zxtzy(ii,jj)
-           xp=xk-sqrt(xl**2+xm**2)
-           xq=xk+sqrt(xl**2+xm**2)
-           xw=1.e-8
-           if(xp.le.xw) xp=0.
-           if(xq.le.xw) xq=xw
-           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
-c slope: 
-cXXX           zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
-cXXXc isotropy:
-cXXX           zgam(ii,jj)=xp/xq*mask(ii,jj)
-cXXXc angle theta:
-cXXX           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
-cXXX           zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
-cXXX           zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
-cXXX           zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
-cXXX           zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
-cXXX           zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
-CXX* PB modif pour maque de terre fractionnaire
-c slope: 
-           zsig(ii,jj)=sqrt(xq)*mask_tmp(ii,jj)
-c isotropy:
-           zgam(ii,jj)=xp/xq*mask_tmp(ii,jj)
-c angle theta:
-           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask_tmp(ii,jj)
-           ! GK211005 (CG) ne pas forcement lisser la topo
-           ! zphi(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
-           zphi(ii,jj)=zmea0(ii,jj)*mask_tmp(ii,jj)
-           !
-           zmea(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
-           zpic(ii,jj)=zpic(ii,jj)*mask_tmp(ii,jj)
-           zval(ii,jj)=zval(ii,jj)*mask_tmp(ii,jj)
-           zstd(ii,jj)=zstd(ii,jj)*mask_tmp(ii,jj)
-c          print 101,ii,jj,
-c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
-c    *           zthe(ii,jj)
-c101  format(1x,2(1x,i2),2(1x,f7.1),1x,f7.4,2x,f4.2,1x,f5.1)     
-         ELSE
-c           PRINT*, 'probleme,ii,jj=', ii,jj
-         ENDIF
-      zllmmea=AMAX1(zmea(ii,jj),zllmmea)
-      zllmstd=AMAX1(zstd(ii,jj),zllmstd)
-      zllmsig=AMAX1(zsig(ii,jj),zllmsig)
-      zllmgam=AMAX1(zgam(ii,jj),zllmgam)
-      zllmthe=AMAX1(zthe(ii,jj),zllmthe)
-      zminthe=amin1(zthe(ii,jj),zminthe)
-      zllmpic=AMAX1(zpic(ii,jj),zllmpic)
-      zllmval=AMAX1(zval(ii,jj),zllmval)
-       ENDDO
-       ENDDO
-      print *,'  MEAN ORO:',zllmmea
-      print *,'  ST. DEV.:',zllmstd
-      print *,'  PENTE:',zllmsig
-      print *,' ANISOTROP:',zllmgam
-      print *,'  ANGLE:',zminthe,zllmthe	
-      print *,'  pic:',zllmpic
-      print *,'  val:',zllmval
-      
-C
-c gamma and theta a 1. and 0. at poles
-c
-      DO jj=1,jmar
-      zmea(imar+1,jj)=zmea(1,jj)
-      zphi(imar+1,jj)=zphi(1,jj)
-      zpic(imar+1,jj)=zpic(1,jj)
-      zval(imar+1,jj)=zval(1,jj)
-      zstd(imar+1,jj)=zstd(1,jj)
-      zsig(imar+1,jj)=zsig(1,jj)
-      zgam(imar+1,jj)=zgam(1,jj)
-      zthe(imar+1,jj)=zthe(1,jj)
-      ENDDO
-
-
-      zmeanor=0.0
-      zmeasud=0.0
-      zstdnor=0.0
-      zstdsud=0.0
-      zsignor=0.0
-      zsigsud=0.0
-      zweinor=0.0
-      zweisud=0.0
-      zpicnor=0.0
-      zpicsud=0.0                                   
-      zvalnor=0.0
-      zvalsud=0.0 
-
-      DO ii=1,imar
-      zweinor=zweinor+              weight(ii,   1)
-      zweisud=zweisud+              weight(ii,jmar)
-      zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)
-      zmeasud=zmeasud+zmea(ii,jmar)*weight(ii,jmar)
-      zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)
-      zstdsud=zstdsud+zstd(ii,jmar)*weight(ii,jmar)
-      zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)
-      zsigsud=zsigsud+zsig(ii,jmar)*weight(ii,jmar)
-      zpicnor=zpicnor+zpic(ii,   1)*weight(ii,   1)
-      zpicsud=zpicsud+zpic(ii,jmar)*weight(ii,jmar)
-      zvalnor=zvalnor+zval(ii,   1)*weight(ii,   1)
-      zvalsud=zvalsud+zval(ii,jmar)*weight(ii,jmar)
-      ENDDO
-
-      DO ii=1,imar+1
-      zmea(ii,   1)=zmeanor/zweinor
-      zmea(ii,jmar)=zmeasud/zweisud
-      zphi(ii,   1)=zmeanor/zweinor
-      zphi(ii,jmar)=zmeasud/zweisud
-      zpic(ii,   1)=zpicnor/zweinor
-      zpic(ii,jmar)=zpicsud/zweisud
-      zval(ii,   1)=zvalnor/zweinor
-      zval(ii,jmar)=zvalsud/zweisud
-      zstd(ii,   1)=zstdnor/zweinor
-      zstd(ii,jmar)=zstdsud/zweisud
-      zsig(ii,   1)=zsignor/zweinor
-      zsig(ii,jmar)=zsigsud/zweisud
-      zgam(ii,   1)=1.
-      zgam(ii,jmar)=1.
-      zthe(ii,   1)=0.
-      zthe(ii,jmar)=0.
-      ENDDO
-
-      RETURN
-      END
-
-      SUBROUTINE MVA9(X,IMAR,JMAR)
-
-C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
-
-      REAL X(IMAR,JMAR),XF(IMAR,JMAR)
-      real WEIGHTpb(-1:1,-1:1)
-
-      
-      SUM=0.
-      DO IS=-1,1
-        DO JS=-1,1
-          WEIGHTpb(IS,JS)=1./REAL((1+IS**2)*(1+JS**2))
-          SUM=SUM+WEIGHTpb(IS,JS)
-        ENDDO
-      ENDDO
-      
-c     WRITE(*,*) 'MVA9 ', IMAR, JMAR
-c     WRITE(*,*) 'MVA9 ', WEIGHTpb
-c     WRITE(*,*) 'MVA9 SUM ', SUM
-      DO IS=-1,1
-        DO JS=-1,1
-          WEIGHTpb(IS,JS)=WEIGHTpb(IS,JS)/SUM
-        ENDDO
-      ENDDO
-
-      DO J=2,JMAR-1
-        DO I=2,IMAR-1
-          XF(I,J)=0.
-          DO IS=-1,1
-            DO JS=-1,1
-              XF(I,J)=XF(I,J)+X(I+IS,J+JS)*WEIGHTpb(IS,JS)
-            ENDDO
-          ENDDO
-        ENDDO
-      ENDDO
-
-      DO J=2,JMAR-1
-        XF(1,J)=0.
-        IS=IMAR-1
-        DO JS=-1,1 
-          XF(1,J)=XF(1,J)+X(IS,J+JS)*WEIGHTpb(-1,JS)
-        ENDDO
-        DO IS=0,1 
-          DO JS=-1,1 
-            XF(1,J)=XF(1,J)+X(1+IS,J+JS)*WEIGHTpb(IS,JS)
-          ENDDO
-        ENDDO
-        XF(IMAR,J)=XF(1,J)
-      ENDDO
-
-      DO I=1,IMAR
-        XF(I,1)=XF(I,2)
-        XF(I,JMAR)=XF(I,JMAR-1)
-      ENDDO
-
-      DO I=1,IMAR
-        DO J=1,JMAR
-          X(I,J)=XF(I,J)
-        ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
Index: LMDZ5/trunk/libf/dyn3dmem/juldate.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/juldate.F	(revision 1943)
+++ 	(revision )
@@ -1,33 +1,0 @@
-!
-! $Header$
-!
-	subroutine juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec)
-c	Sous-routine de changement de date:
-c	gregorien>>>date julienne
-c	En entree:an,mois,jour,heure,min.,sec.
-c	En sortie:tjd
-	implicit real (a-h,o-z)
-	frac=((os/60.+om)/60.+oh)/24.
-	ojou=dfloat(ijou)+frac
-	    year=dfloat(ian)
-	    rmon=dfloat(imoi)
-	if (imoi .le. 2) then
-	    year=year-1.
-	    rmon=rmon+12.
-	endif
-	cf=year+(rmon/100.)+(ojou/10000.)
-	if (cf .ge. 1582.1015) then
-	    a=int(year/100)
-	    b=2-a+int(a/4)
-	else
-	    b=0
-	endif
-	tjd=int(365.25*year)+int(30.6001*(rmon+1))+int(ojou)
-     +   +1720994.5+b
-        tjdsec=(ojou-int(ojou))+(tjd-int(tjd))
-        tjd=int(tjd)+int(tjdsec)
-	tjdsec=tjdsec-int(tjdsec)
-	return
-	end
-
-
Index: LMDZ5/trunk/libf/dyn3dmem/pres2lev_mod.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/pres2lev_mod.F90	(revision 1943)
+++ 	(revision )
@@ -1,80 +1,0 @@
-! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $
-!
-MODULE pres2lev_mod
-
-CONTAINS 
-
-!******************************************************
-SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn,ni,nj,ok_invertp)
-!
-! interpolation lineaire pour passer
-! a une nouvelle discretisation verticale pour
-! les variables de GCM
-! Francois Forget (01/1995)
-! MOdif remy roca 12/97 pour passer de pres2sig
-! Modif F.Codron 07/08 po en 3D
-!**********************************************************
-
-  IMPLICIT NONE
-
-!   Declarations:
-! ==============
-!
-!  ARGUMENTS
-!  """""""""
-  LOGICAL, INTENT(IN) :: ok_invertp
-  INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
-  INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
-  
-  REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille
-  REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille
-
-  INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
-
-  REAL, INTENT(IN)  :: varo(ni*nj,lmo) ! var dans l'ancienne grille
-  REAL, INTENT(OUT) :: varn(ni*nj,lmn) ! var dans la nouvelle grille
-
-  REAL :: zvaro(ni*nj,lmo),zpo(ni*nj,lmo)
-
-! Autres variables
-! """"""""""""""""
-  INTEGER ::  ln ,lo, k
-  REAL    :: coef
-
-
-! Inversion de l'ordre des niveaux verticaux
-  IF (ok_invertp) THEN
-    DO lo=1,lmo
-      DO k=1,ni*nj
-        zpo(k,lo)=po(k,lmo+1-lo)
-        zvaro(k,lo)=varo(k,lmo+1-lo)
-      ENDDO
-    ENDDO
-  ELSE
-    DO lo=1,lmo
-      DO k=1,ni*nj
-        zpo(k,lo)=po(k,lo)
-        zvaro(k,lo)=varo(k,lo)
-      ENDDO
-    ENDDO
-  ENDIF 
-
-  DO ln=1,lmn
-    DO lo=1,lmo-1
-      DO k=1,ni*nj
-        IF (pn(k,ln) >= zpo(k,1) ) THEN
-          varn(k,ln) = zvaro(k,1)
-        ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN
-          varn(k,ln) = zvaro(k,lmo)
-        ELSE IF ( pn(k,ln) <= zpo(k,lo) .AND. pn(k,ln) > zpo(k,lo+1) ) THEN
-          coef = (pn(k,ln)-zpo(k,lo)) / (zpo(k,lo+1)-zpo(k,lo))
-          varn(k,ln) = zvaro(k,lo) + coef*(zvaro(k,lo+1)-zvaro(k,lo))
-        ENDIF
-         
-      ENDDO  
-    ENDDO
-  ENDDO                
-
-END SUBROUTINE pres2lev    
-
-END MODULE pres2lev_mod
Index: LMDZ5/trunk/libf/dyn3dmem/ran1.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/ran1.F	(revision 1943)
+++ 	(revision )
@@ -1,34 +1,0 @@
-!
-! $Id: ran1.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      FUNCTION RAN1(IDUM)
-      DIMENSION R(97)
-      save r
-      save iff,ix1,ix2,ix3
-      PARAMETER (M1=259200,IA1=7141,IC1=54773,RM1=3.8580247E-6)
-      PARAMETER (M2=134456,IA2=8121,IC2=28411,RM2=7.4373773E-6)
-      PARAMETER (M3=243000,IA3=4561,IC3=51349)
-      DATA IFF /0/
-      IF (IDUM.LT.0.OR.IFF.EQ.0) THEN
-        IFF=1
-        IX1=MOD(IC1-IDUM,M1)
-        IX1=MOD(IA1*IX1+IC1,M1)
-        IX2=MOD(IX1,M2)
-        IX1=MOD(IA1*IX1+IC1,M1)
-        IX3=MOD(IX1,M3)
-        DO 11 J=1,97
-          IX1=MOD(IA1*IX1+IC1,M1)
-          IX2=MOD(IA2*IX2+IC2,M2)
-          R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
-11      CONTINUE
-        IDUM=1
-      ENDIF
-      IX1=MOD(IA1*IX1+IC1,M1)
-      IX2=MOD(IA2*IX2+IC2,M2)
-      IX3=MOD(IA3*IX3+IC3,M3)
-      J=1+(97*IX3)/M3
-      IF(J.GT.97.OR.J.LT.1)PAUSE
-      RAN1=R(J)
-      R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dpar/defrun.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dpar/defrun.F	(revision 1943)
+++ 	(revision )
@@ -1,497 +1,0 @@
-!
-! $Id$
-!
-c
-c
-      SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
-c
-      USE control_mod
-      IMPLICIT NONE
-c-----------------------------------------------------------------------
-c     Auteurs :   L. Fairhead , P. Le Van  .
-c
-c     Arguments :
-c
-c     tapedef   :
-c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
-c     -metres  du zoom  avec  celles lues sur le fichier start .
-c      clesphy0 :  sortie  .
-c
-       LOGICAL etatinit
-       INTEGER tapedef
-
-       INTEGER        longcles
-       PARAMETER(     longcles = 20 )
-       REAL clesphy0( longcles )
-c
-c   Declarations :
-c   --------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "logic.h"
-#include "serre.h"
-#include "comdissnew.h"
-#include "clesph0.h"
-c
-c
-c   local:
-c   ------
-
-      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
-      INTEGER   tapeout
-      REAL clonn,clatt,grossismxx,grossismyy
-      REAL dzoomxx,dzoomyy,tauxx,tauyy
-      LOGICAL  fxyhypbb, ysinuss
-      INTEGER i
-      
-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 de tapedef : ** 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  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  grossismx ,
-c    grossismy,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( tapedef,file ='gcm.def',status='old',form='formatted')
-
-
-      READ (tapedef,9000) ch1,ch2,ch3
-      WRITE(tapeout,9000) ch1,ch2,ch3
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dayref
-      WRITE(tapeout,9001) ch1,'dayref'
-      WRITE(tapeout,*)    dayref
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    anneeref
-      WRITE(tapeout,9001) ch1,'anneeref'
-      WRITE(tapeout,*)    anneeref
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nday
-      WRITE(tapeout,9001) ch1,'nday'
-      WRITE(tapeout,*)    nday
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    day_step
-      WRITE(tapeout,9001) ch1,'day_step'
-      WRITE(tapeout,*)    day_step
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iperiod
-      WRITE(tapeout,9001) ch1,'iperiod'
-      WRITE(tapeout,*)    iperiod
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iapp_tracvl
-      WRITE(tapeout,9001) ch1,'iapp_tracvl'
-      WRITE(tapeout,*)    iapp_tracvl
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iconser
-      WRITE(tapeout,9001) ch1,'iconser'
-      WRITE(tapeout,*)    iconser
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iecri
-      WRITE(tapeout,9001) ch1,'iecri'
-      WRITE(tapeout,*)    iecri
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    periodav
-      WRITE(tapeout,9001) ch1,'periodav'
-      WRITE(tapeout,*)    periodav
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dissip_period
-      WRITE(tapeout,9001) ch1,'dissip_period'
-      WRITE(tapeout,*)    dissip_period
-
-ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
-ccc
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    lstardis
-      WRITE(tapeout,9001) ch1,'lstardis'
-      WRITE(tapeout,*)    lstardis
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nitergdiv
-      WRITE(tapeout,9001) ch1,'nitergdiv'
-      WRITE(tapeout,*)    nitergdiv
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nitergrot
-      WRITE(tapeout,9001) ch1,'nitergrot'
-      WRITE(tapeout,*)    nitergrot
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    niterh
-      WRITE(tapeout,9001) ch1,'niterh'
-      WRITE(tapeout,*)    niterh
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetagdiv
-      WRITE(tapeout,9001) ch1,'tetagdiv'
-      WRITE(tapeout,*)    tetagdiv
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetagrot
-      WRITE(tapeout,9001) ch1,'tetagrot'
-      WRITE(tapeout,*)    tetagrot
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetatemp
-      WRITE(tapeout,9001) ch1,'tetatemp'
-      WRITE(tapeout,*)    tetatemp
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    coefdis
-      WRITE(tapeout,9001) ch1,'coefdis'
-      WRITE(tapeout,*)    coefdis
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    purmats
-      WRITE(tapeout,9001) ch1,'purmats'
-      WRITE(tapeout,*)    purmats
-
-c    ...............................................................
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iflag_phys
-      WRITE(tapeout,9001) ch1,'iflag_phys'
-      WRITE(tapeout,*)    iflag_phys
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iphysiq
-      WRITE(tapeout,9001) ch1,'iphysiq'
-      WRITE(tapeout,*)    iphysiq
-
-
-ccc   .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ...
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    cycle_diurne
-      WRITE(tapeout,9001) ch1,'cycle_diurne'
-      WRITE(tapeout,*)    cycle_diurne
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    soil_model
-      WRITE(tapeout,9001) ch1,'soil_model'
-      WRITE(tapeout,*)    soil_model
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    new_oliq
-      WRITE(tapeout,9001) ch1,'new_oliq'
-      WRITE(tapeout,*)    new_oliq
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_orodr
-      WRITE(tapeout,9001) ch1,'ok_orodr'
-      WRITE(tapeout,*)    ok_orodr
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_orolf
-      WRITE(tapeout,9001) ch1,'ok_orolf'
-      WRITE(tapeout,*)    ok_orolf
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_limitvrai
-      WRITE(tapeout,9001) ch1,'ok_limitvrai'
-      WRITE(tapeout,*)    ok_limitvrai
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nbapp_rad
-      WRITE(tapeout,9001) ch1,'nbapp_rad'
-      WRITE(tapeout,*)    nbapp_rad
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iflag_con
-      WRITE(tapeout,9001) ch1,'iflag_con'
-      WRITE(tapeout,*)    iflag_con
-
-      DO i = 1, longcles
-       clesphy0(i) = 0.
-      ENDDO
-                          clesphy0(1) = REAL( iflag_con )
-                          clesphy0(2) = REAL( nbapp_rad )
-
-       IF( cycle_diurne  ) clesphy0(3) =  1.
-       IF(   soil_model  ) clesphy0(4) =  1.
-       IF(     new_oliq  ) clesphy0(5) =  1.
-       IF(     ok_orodr  ) clesphy0(6) =  1.
-       IF(     ok_orolf  ) clesphy0(7) =  1.
-       IF(  ok_limitvrai ) clesphy0(8) =  1.
-
-
-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 (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clonn
-      WRITE(tapeout,9001) ch1,'clon'
-      WRITE(tapeout,*)    clonn
-      IF( ABS(clon - clonn).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de clon passee par run.def est diffe
-     *rente de  celle lue sur le fichier  start '
-        STOP
-      ENDIF
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clatt
-      WRITE(tapeout,9001) ch1,'clat'
-      WRITE(tapeout,*)    clatt
-
-      IF( ABS(clat - clatt).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de clat passee par run.def est diffe
-     *rente de  celle lue sur le fichier  start '
-        STOP
-      ENDIF
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismxx
-      WRITE(tapeout,9001) ch1,'grossismx'
-      WRITE(tapeout,*)    grossismxx
-
-      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de grossismx passee par run.def est
-     , differente de celle lue sur le fichier  start '
-        STOP
-      ENDIF
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismyy
-      WRITE(tapeout,9001) ch1,'grossismy'
-      WRITE(tapeout,*)    grossismyy
-
-      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de grossismy passee par run.def est
-     , differente de celle lue sur le fichier  start '
-        STOP
-      ENDIF
-      
-      IF( grossismx.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismx < 1 .   *** '
-         STOP
-      ELSE
-         alphax = 1. - 1./ grossismx
-      ENDIF
-
-
-      IF( grossismy.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
-         STOP
-      ELSE
-         alphay = 1. - 1./ grossismy
-      ENDIF
-
-c
-c    alphax et alphay sont les anciennes formulat. des grossissements
-c
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    fxyhypbb
-      WRITE(tapeout,9001) ch1,'fxyhypbb'
-      WRITE(tapeout,*)    fxyhypbb
-
-      IF( .NOT.fxyhypb )  THEN
-           IF( fxyhypbb )     THEN
-            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
-            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est F'
-     *,      '                   alors  qu il est  T  sur  run.def  ***'
-              STOP
-           ENDIF
-      ELSE
-           IF( .NOT.fxyhypbb )   THEN
-            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
-            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est t'
-     *,      '                   alors  qu il est  F  sur  run.def  ***'
-              STOP
-           ENDIF
-      ENDIF
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomxx
-      WRITE(tapeout,9001) ch1,'dzoomx'
-      WRITE(tapeout,*)    dzoomxx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomyy
-      WRITE(tapeout,9001) ch1,'dzoomy'
-      WRITE(tapeout,*)    dzoomyy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauxx
-      WRITE(tapeout,9001) ch1,'taux'
-      WRITE(tapeout,*)    tauxx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauyy
-      WRITE(tapeout,9001) ch1,'tauy'
-      WRITE(tapeout,*)    tauyy
-
-      IF( fxyhypb )  THEN
-
-       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
-        WRITE(tapeout,*)' La valeur de dzoomx passee par run.def est dif
-     *ferente de celle lue sur le fichier  start '
-        CALL ABORT
-       ENDIF
-
-       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
-        WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
-     *ferente de celle lue sur le fichier  start '
-        CALL ABORT
-       ENDIF
-
-       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
-        WRITE(6,*)' La valeur de taux passee par run.def est differente
-     *  de celle lue sur le fichier  start '
-        CALL ABORT
-       ENDIF
-
-       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
-        WRITE(6,*)' La valeur de tauy passee par run.def est differente
-     *  de celle lue sur le fichier  start '
-        CALL ABORT
-       ENDIF
-
-      ENDIF
-      
-cc
-      IF( .NOT.fxyhypb  )  THEN
-        READ (tapedef,9001) ch1,ch4
-        READ (tapedef,*)    ysinuss
-        WRITE(tapeout,9001) ch1,'ysinus'
-        WRITE(tapeout,*)    ysinuss
-
-
-        IF( .NOT.ysinus )  THEN
-           IF( ysinuss )     THEN
-              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
-              WRITE(tapeout,*)'** ysinus lu sur le fichier start est F',
-     *       ' alors  qu il est  T  sur  run.def  ***'
-              STOP
-           ENDIF
-        ELSE
-           IF( .NOT.ysinuss )   THEN
-              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
-              WRITE(tapeout,*)'** ysinus lu sur le fichier start est T',
-     *       ' alors  qu il est  F  sur  run.def  ***'
-              STOP
-           ENDIF
-        ENDIF
-      ENDIF
-c
-      WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
-
-      CLOSE(tapedef)
-
-      RETURN
-c   ...............................................
-c
-100   CONTINUE
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clon
-      WRITE(tapeout,9001) ch1,'clon'
-      WRITE(tapeout,*)    clon
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clat
-      WRITE(tapeout,9001) ch1,'clat'
-      WRITE(tapeout,*)    clat
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismx
-      WRITE(tapeout,9001) ch1,'grossismx'
-      WRITE(tapeout,*)    grossismx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismy
-      WRITE(tapeout,9001) ch1,'grossismy'
-      WRITE(tapeout,*)    grossismy
-
-      IF( grossismx.LT.1. )  THEN
-        WRITE(tapeout,*) '***  ATTENTION !! grossismx < 1 .   *** '
-         STOP
-      ELSE
-         alphax = 1. - 1./ grossismx
-      ENDIF
-
-      IF( grossismy.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
-         STOP
-      ELSE
-         alphay = 1. - 1./ grossismy
-      ENDIF
-
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    fxyhypb
-      WRITE(tapeout,9001) ch1,'fxyhypb'
-      WRITE(tapeout,*)    fxyhypb
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomx
-      WRITE(tapeout,9001) ch1,'dzoomx'
-      WRITE(tapeout,*)    dzoomx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomy
-      WRITE(tapeout,9001) ch1,'dzoomy'
-      WRITE(tapeout,*)    dzoomy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    taux
-      WRITE(tapeout,9001) ch1,'taux'
-      WRITE(tapeout,*)    taux
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauy
-      WRITE(tapeout,9001) ch1,'tauy'
-      WRITE(tapeout,*)    tauy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ysinus
-      WRITE(tapeout,9001) ch1,'ysinus'
-      WRITE(tapeout,*)    ysinus
-       
-      WRITE(tapeout,*) ' alphax alphay defrun ',alphax,alphay
-c
-9000  FORMAT(3(/,a72))
-9001  FORMAT(/,a72,/,a12)
-cc
-      CLOSE(tapedef)
-
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dpar/fyhyp.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dpar/fyhyp.F	(revision 1943)
+++ 	(revision )
@@ -1,378 +1,0 @@
-!
-! $Id$
-!
-c
-c
-       SUBROUTINE fyhyp ( yzoomdeg, grossism, dzooma,tau  ,  
-     ,  rrlatu,yyprimu,rrlatv,yyprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
-     ,  champmin,champmax                                            ) 
-
-cc    ...  Version du 01/04/2001 ....
-
-       IMPLICIT NONE
-c
-c    ...   Auteur :  P. Le Van  ... 
-c
-c    .......    d'apres  formulations  de R. Sadourny  .......
-c
-c     Calcule les latitudes et derivees dans la grille du GCM pour une
-c     fonction f(y) a tangente  hyperbolique  .
-c
-c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois , etc)
-c     dzoom  etant  la distance totale de la zone du zoom ( en radians )
-c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom   
-c
-c
-c N.B : Il vaut mieux avoir : grossism * dzoom  <  pi/2  (radians) ,en lati.
-c      ********************************************************************
-c
-c
-#include "dimensions.h"
-#include "paramet.h"
-
-       INTEGER      nmax , nmax2
-       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
-c
-c
-c     .......  arguments  d'entree    .......
-c
-       REAL yzoomdeg, grossism,dzooma,tau 
-c         ( rentres  par  run.def )
-
-c     .......  arguments  de sortie   .......
-c
-       REAL rrlatu(jjp1), yyprimu(jjp1),rrlatv(jjm), yyprimv(jjm),
-     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
-
-c
-c     .....     champs  locaux    .....
-c
-     
-       REAL   dzoom
-       REAL(KIND=8) ylat(jjp1), yprim(jjp1)
-       REAL(KIND=8) yuv
-       REAL(KIND=8) yt(0:nmax2)
-       REAL(KIND=8) fhyp(0:nmax2),beta,Ytprim(0:nmax2),fxm(0:nmax2)
-       SAVE Ytprim, yt,Yf
-       REAL(KIND=8) Yf(0:nmax2),yypr(0:nmax2)
-       REAL(KIND=8) yvrai(jjp1), yprimm(jjp1),ylatt(jjp1)
-       REAL(KIND=8) pi,depi,pis2,epsilon,y0,pisjm
-       REAL(KIND=8) yo1,yi,ylon2,ymoy,Yprimin,champmin,champmax
-       REAL(KIND=8) yfi,Yf1,ffdy
-       REAL(KIND=8) ypn,deply,y00
-       SAVE y00, deply
-
-       INTEGER i,j,it,ik,iter,jlat
-       INTEGER jpn,jjpn
-       SAVE jpn
-       REAL(KIND=8) a0,a1,a2,a3,yi2,heavyy0,heavyy0m
-       REAL(KIND=8) fa(0:nmax2),fb(0:nmax2)
-       REAL y0min,y0max
-
-       REAL(KIND=8)     heavyside
-
-       pi       = 2. * ASIN(1.)
-       depi     = 2. * pi
-       pis2     = pi/2.
-       pisjm    = pi/ REAL(jjm)
-       epsilon  = 1.e-3
-       y0       =  yzoomdeg * pi/180. 
-
-       IF( dzooma.LT.1.)  THEN
-         dzoom = dzooma * pi
-       ELSEIF( dzooma.LT. 12. ) THEN
-         WRITE(6,*) ' Le param. dzoomy pour fyhyp est trop petit ! L aug
-     ,menter et relancer ! '
-         STOP 1
-       ELSE
-         dzoom = dzooma * pi/180.
-       ENDIF
-
-       WRITE(6,18)
-       WRITE(6,*) ' yzoom( rad.),grossism,tau,dzoom (radians)'
-       WRITE(6,24) y0,grossism,tau,dzoom
-
-       DO i = 0, nmax2 
-        yt(i) = - pis2  + REAL(i)* pi /nmax2
-       ENDDO
-
-       heavyy0m = heavyside( -y0 )
-       heavyy0  = heavyside(  y0 )
-       y0min    = 2.*y0*heavyy0m - pis2
-       y0max    = 2.*y0*heavyy0  + pis2
-
-       fa = 999.999
-       fb = 999.999
-       
-       DO i = 0, nmax2 
-        IF( yt(i).LT.y0 )  THEN
-         fa (i) = tau*  (yt(i)-y0+dzoom/2. )
-         fb(i) =   (yt(i)-2.*y0*heavyy0m +pis2) * ( y0 - yt(i) )
-        ELSEIF ( yt(i).GT.y0 )  THEN
-         fa(i) =   tau *(y0-yt(i)+dzoom/2. )
-         fb(i) = (2.*y0*heavyy0 -yt(i)+pis2) * ( yt(i) - y0 ) 
-       ENDIF
-        
-       IF( 200.* fb(i) .LT. - fa(i) )   THEN
-         fhyp ( i) = - 1.
-       ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
-         fhyp ( i) =   1.
-       ELSE  
-         fhyp(i) =  TANH ( fa(i)/fb(i) )
-       ENDIF
-
-       IF( yt(i).EQ.y0 )  fhyp(i) = 1.
-       IF(yt(i).EQ. y0min. OR.yt(i).EQ. y0max ) fhyp(i) = -1.
-
-       ENDDO
-
-cc  ....  Calcul  de  beta  ....
-c
-       ffdy   = 0.
-
-       DO i = 1, nmax2
-        ymoy    = 0.5 * ( yt(i-1) + yt( i ) )
-        IF( ymoy.LT.y0 )  THEN
-         fa(i)= tau * ( ymoy-y0+dzoom/2.) 
-         fb(i) = (ymoy-2.*y0*heavyy0m +pis2) * ( y0 - ymoy )
-        ELSEIF ( ymoy.GT.y0 )  THEN
-         fa(i)= tau * ( y0-ymoy+dzoom/2. ) 
-         fb(i) = (2.*y0*heavyy0 -ymoy+pis2) * ( ymoy - y0 )
-        ENDIF
-
-        IF( 200.* fb(i) .LT. - fa(i) )    THEN
-         fxm ( i) = - 1.
-        ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
-         fxm ( i) =   1.
-        ELSE
-         fxm(i) =  TANH ( fa(i)/fb(i) )
-        ENDIF
-         IF( ymoy.EQ.y0 )  fxm(i) = 1.
-         IF (ymoy.EQ. y0min. OR.yt(i).EQ. y0max ) fxm(i) = -1.
-         ffdy = ffdy + fxm(i) * ( yt(i) - yt(i-1) )
-
-        ENDDO
-
-        beta  = ( grossism * ffdy - pi ) / ( ffdy - pi )
-
-       IF( 2.*beta - grossism.LE. 0.)  THEN
-
-        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
-     ,tine fyhyp est mauvaise ! '
-        WRITE(6,*)'Modifier les valeurs de  grossismy ,tauy ou dzoomy',
-     , ' et relancer ! ***  '
-        CALL ABORT_GCM("FYHYP", "", 1)
-
-       ENDIF
-c
-c   .....  calcul  de  Ytprim   .....
-c
-       
-       DO i = 0, nmax2
-        Ytprim(i) = beta  + ( grossism - beta ) * fhyp(i)
-       ENDDO
-
-c   .....  Calcul  de  Yf     ........
-
-       Yf(0) = - pis2
-       DO i = 1, nmax2
-        yypr(i)    = beta + ( grossism - beta ) * fxm(i)
-       ENDDO
-
-       DO i=1,nmax2
-        Yf(i)   = Yf(i-1) + yypr(i) * ( yt(i) - yt(i-1) )
-       ENDDO
-
-c    ****************************************************************
-c
-c   .....   yuv  = 0.   si calcul des latitudes  aux pts.  U  .....
-c   .....   yuv  = 0.5  si calcul des latitudes  aux pts.  V  .....
-c
-      WRITE(6,18)
-c
-      DO 5000  ik = 1,4
-
-       IF( ik.EQ.1 )  THEN
-         yuv  = 0.
-         jlat = jjm + 1
-       ELSE IF ( ik.EQ.2 )  THEN
-         yuv  = 0.5
-         jlat = jjm 
-       ELSE IF ( ik.EQ.3 )  THEN
-         yuv  = 0.25
-         jlat = jjm 
-       ELSE IF ( ik.EQ.4 )  THEN
-         yuv  = 0.75
-         jlat = jjm 
-       ENDIF
-c
-       yo1   = 0.
-       DO 1500 j =  1,jlat
-        yo1   = 0.
-        ylon2 =  - pis2 + pisjm * ( REAL(j)  + yuv  -1.)  
-        yfi    = ylon2
-c
-       DO 250 it =  nmax2,0,-1
-        IF( yfi.GE.Yf(it))  GO TO 350
-250    CONTINUE
-       it = 0
-350    CONTINUE
-
-       yi = yt(it)
-       IF(it.EQ.nmax2)  THEN
-        it       = nmax2 -1
-        Yf(it+1) = pis2
-       ENDIF
-c  .................................................................
-c  ....  Interpolation entre  yi(it) et yi(it+1)   pour avoir Y(yi)  
-c      .....           et   Y'(yi)                             .....
-c  .................................................................
-
-       CALL coefpoly ( Yf(it),Yf(it+1),Ytprim(it), Ytprim(it+1),   
-     ,                  yt(it),yt(it+1) ,   a0,a1,a2,a3   )      
-
-       Yf1     = Yf(it)
-       Yprimin = a1 + 2.* a2 * yi + 3.*a3 * yi *yi
-
-       DO 500 iter = 1,300
-         yi = yi - ( Yf1 - yfi )/ Yprimin
-
-        IF( ABS(yi-yo1).LE.epsilon)  GO TO 550
-         yo1      = yi
-         yi2      = yi * yi
-         Yf1      = a0 +  a1 * yi +     a2 * yi2  +     a3 * yi2 * yi
-         Yprimin  =       a1      + 2.* a2 *  yi  + 3.* a3 * yi2
-500   CONTINUE
-        WRITE(6,*) ' Pas de solution ***** ',j,ylon2,iter
-         STOP 2
-550   CONTINUE
-c
-       Yprimin   = a1  + 2.* a2 *  yi   + 3.* a3 * yi* yi
-       yprim(j)  = pi / ( jjm * Yprimin )
-       yvrai(j)  = yi 
-
-1500    CONTINUE
-
-       DO j = 1, jlat -1
-        IF( yvrai(j+1). LT. yvrai(j) )  THEN
-         WRITE(6,*) ' PBS. avec  rlat(',j+1,') plus petit que rlat(',j,
-     ,  ')'
-         STOP 3
-        ENDIF
-       ENDDO
-
-       WRITE(6,*) 'Reorganisation des latitudes pour avoir entre - pi/2'
-     , ,' et  pi/2 '
-c
-        IF( ik.EQ.1 )   THEN
-           ypn = pis2 
-          DO j = jlat,1,-1
-           IF( yvrai(j).LE. ypn ) GO TO 1502
-          ENDDO
-1502     CONTINUE
-
-         jpn   = j
-         y00   = yvrai(jpn)
-         deply = pis2 -  y00
-        ENDIF
-
-         DO  j = 1, jjm +1 - jpn
-           ylatt (j)  = -pis2 - y00  + yvrai(jpn+j-1)
-           yprimm(j)  = yprim(jpn+j-1)
-         ENDDO
-
-         jjpn  = jpn
-         IF( jlat.EQ. jjm ) jjpn = jpn -1
-
-         DO j = 1,jjpn 
-          ylatt (j + jjm+1 -jpn) = yvrai(j) + deply
-          yprimm(j + jjm+1 -jpn) = yprim(j)
-         ENDDO
-
-c      ***********   Fin de la reorganisation     *************
-c
- 1600   CONTINUE
-
-       DO j = 1, jlat
-          ylat(j) =  ylatt( jlat +1 -j )
-         yprim(j) = yprimm( jlat +1 -j )
-       ENDDO
-  
-        DO j = 1, jlat
-         yvrai(j) = ylat(j)*180./pi
-        ENDDO
-
-        IF( ik.EQ.1 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT  en U   apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rrlatu(j) =  ylat( j )
-           yyprimu(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 2 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*) ' YLAT   en V  apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*)' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rrlatv(j) =  ylat( j )
-           yyprimv(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 3 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT  en U + 0.75  apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rlatu2(j) =  ylat( j )
-           yprimu2(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 4 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT en U + 0.25  apres ( en  deg. ) '
-c         WRITE(6,68)(yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,68) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rlatu1(j) =  ylat( j )
-           yprimu1(j) = yprim( j )
-          ENDDO
-
-        ENDIF
-
-5000   CONTINUE
-c
-        WRITE(6,18)
-c
-c  .....     fin de la boucle  do 5000 .....
-
-        DO j = 1, jjm
-         ylat(j) = rrlatu(j) - rrlatu(j+1)
-        ENDDO
-        champmin =  1.e12
-        champmax = -1.e12
-        DO j = 1, jjm
-         champmin = MIN( champmin, ylat(j) )
-         champmax = MAX( champmax, ylat(j) )
-        ENDDO
-         champmin = champmin * 180./pi
-         champmax = champmax * 180./pi
-
-24     FORMAT(2x,'Parametres yzoom,gross,tau ,dzoom pour fyhyp ',4f8.3)
-18      FORMAT(/)
-68      FORMAT(1x,7f9.2)
-
-        RETURN
-        END
Index: LMDZ5/trunk/libf/dyn3dpar/grid_atob.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dpar/grid_atob.F	(revision 1943)
+++ 	(revision )
@@ -1,971 +1,0 @@
-!
-! $Id$
-!
-      SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie)
-c=======================================================================
-c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
-c
-c Methode naive pour transformer un champ d'une grille fine a une
-c grille grossiere. Je considere que les nouveaux points occupent
-c une zone adjacente qui comprend un ou plusieurs anciens points
-c
-c Aucune ponderation est consideree (voir grille_p)
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        sortie: champ de sortie deja transforme
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL number(2200,1100)
-      REAL distans(2200*1100)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-c Calculer les limites des zones des nouveaux points
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c Determiner la zone sur laquelle chaque ancien point se trouve
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               number(ii,jj) = number(ii,jj) + 1.0
-               sortie(ii,jj) = sortie(ii,jj) + entree(i,j)
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c Si aucun ancien point tombe sur une zone, c'est un probleme
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (number(i,j) .GT. 0.001) THEN
-         sortie(i,j) = sortie(i,j) / number(i,j)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-ccc         CALL ABORT_GCM("", "", 1)
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         sortie(i,j) = entree(i_proche,j_proche)
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-      SUBROUTINE grille_p(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie)
-c=======================================================================
-c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
-c
-c Methode naive pour transformer un champ d'une grille fine a une
-c grille grossiere. Je considere que les nouveaux points occupent
-c une zone adjacente qui comprend un ou plusieurs anciens points
-c
-c Consideration de la distance des points (voir grille_m)
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        sortie: champ de sortie deja transforme
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(200),d(200)
-      REAL number(400,200)
-      INTEGER indx(400,200), indy(400,200)
-      REAL dist(400,200), distsom(400,200)
-c
-      IF (imar.GT.400 .OR. jmar.GT.200) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-      IF (imdep.GT.400 .OR. jmdep.GT.200) THEN
-         PRINT*, 'imdep ou jmdep trop grand', imdep, jmdep
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-c calculer les bords a et b de la nouvelle grille
-c
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-c
-c calculer les bords c et d de la nouvelle grille
-c
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-c
-c trouver les indices (indx,indy) de la nouvelle grille sur laquelle
-c un point de l'ancienne grille est tombe.
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               indx(i,j) = ii
-               indy(i,j) = jj
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c faire une verification
-c
-
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         IF (indx(i,j).GT.imar .OR. indy(i,j).GT.jmar) THEN
-            PRINT*, 'Probleme grave,i,j,indx,indy=',
-     .              i,j,indx(i,j),indy(i,j)
-            call abort_gcm("", "", 1)
-         ENDIF
-      ENDDO
-      ENDDO
-
-c
-c calculer la distance des anciens points avec le nouveau point,
-c on prend ensuite une sorte d'inverse pour ponderation.
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         distsom(i,j) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         dist(i,j) = SQRT ( (xdata(i)-x(indx(i,j)))**2
-     .                     +(ydata(j)-y(indy(i,j)))**2 )
-         distsom(indx(i,j),indy(i,j)) = distsom(indx(i,j),indy(i,j))
-     .                                  + dist(i,j)
-         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j)) +1.
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         dist(i,j) = 1.0 - dist(i,j)/distsom(indx(i,j),indy(i,j))
-      ENDDO
-      ENDDO
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         sortie(indx(i,j),indy(i,j)) = sortie(indx(i,j),indy(i,j))
-     .                                 + entree(i,j) * dist(i,j)
-         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j))
-     .                                 + dist(i,j)
-      ENDDO
-      ENDDO
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (number(i,j) .GT. 0.001) THEN
-         sortie(i,j) = sortie(i,j) / number(i,j)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT_GCM("", "", 1)
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-
-      SUBROUTINE mask_c_o(imdep, jmdep, xdata, ydata, relief,
-     .                    imar, jmar, x, y, mask)
-c=======================================================================
-c z.x.li (le 1 avril 1994): A partir du champ de relief, on fabrique
-c                           un champ indicateur (masque) terre/ocean
-c                           terre:1; ocean:0
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL relief(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL mask(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL num_tot(2200,1100), num_oce(2200,1100)
-c
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_oce(i,j) = 0.0
-         num_tot(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-               IF (.NOT. ( relief(i,j) - 0.9. GE. 1.e-5 ) )
-     .             num_oce(ii,jj) = num_oce(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-c
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (num_tot(i,j) .GT. 0.001) THEN
-           IF ( num_oce(i,j)/num_tot(i,j) - 0.5 .GE. 1.e-5 ) THEN
-              mask(i,j) = 0.
-           ELSE
-              mask(i,j) = 1.
-           ENDIF
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT_GCM("", "", 1)
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-c
-c
-
-
-      SUBROUTINE rugosite(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie, mask)
-c=======================================================================
-c z.x.li (le 1 avril 1994): Transformer la longueur de rugosite d'une
-c grille fine a une grille grossiere. Sur l'ocean, on impose une valeur
-c fixe (0.001m).
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar), mask(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(400),d(400)
-      REAL num_tot(400,400)
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      IF (imar.GT.400 .OR. jmar.GT.400) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_tot(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              sortie(ii,jj)  = sortie(ii,jj) + LOG(entree(i,j))
-              num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-       IF (NINT(mask(i,j)).EQ.1) THEN
-         IF (num_tot(i,j) .GT. 0.0) THEN
-            sortie(i,j) = sortie(i,j) / num_tot(i,j)
-            sortie(i,j) = EXP(sortie(i,j))
-         ELSE
-            PRINT*, 'probleme,i,j=', i,j
-ccc            CALL ABORT_GCM("", "", 1)
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         sortie(i,j) = entree(i_proche,j_proche)
-         ENDIF
-       ELSE
-         sortie(i,j) = 0.001
-       ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-
-
-      SUBROUTINE sea_ice(imdep, jmdep, xdata, ydata, glace01,
-     .                    imar, jmar, x, y, frac_ice)
-c=======================================================================
-c z.x.li (le 1 avril 1994): Transformer un champ d'indicateur de la
-c glace (1, sinon 0) d'une grille fine a un champ de fraction de glace
-c (entre 0 et 1) dans une grille plus grossiere.
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL glace01(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL frac_ice(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(400),d(400)
-      REAL num_tot(400,400), num_ice(400,400)
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      IF (imar.GT.400 .OR. jmar.GT.400) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_ice(i,j) = 0.0
-         num_tot(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-             num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-              IF (NINT(glace01(i,j)).EQ.1 ) 
-     .       num_ice(ii,jj) = num_ice(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (num_tot(i,j) .GT. 0.001) THEN
-           IF (num_ice(i,j).GT.0.001) THEN
-            frac_ice(i,j) = num_ice(i,j) / num_tot(i,j)
-           ELSE
-              frac_ice(i,j) = 0.0
-           ENDIF
-         ELSE
-           PRINT*, 'probleme,i,j=', i,j
-ccc           CALL ABORT_GCM("", "", 1)
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         IF (NINT(glace01(i_proche,j_proche)).EQ.1 ) THEN
-            frac_ice(i,j) = 1.0
-         ELSE
-            frac_ice(i,j) = 0.0
-         ENDIF
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-      SUBROUTINE rugsoro(imrel, jmrel, xrel, yrel, relief,
-     .                    immod, jmmod, xmod, ymod, rugs)
-c=======================================================================
-c Calculer la longueur de rugosite liee au relief en utilisant
-c l'ecart-type dans une maille de 1x1
-C=======================================================================
-      IMPLICIT none
-c
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      REAL amin, AMAX
-c
-      INTEGER imrel, jmrel
-      REAL xrel(imrel),yrel(jmrel)
-      REAL relief(imrel,jmrel)
-c
-      INTEGER immod, jmmod
-      REAL xmod(immod),ymod(jmmod)
-      REAL rugs(immod,jmmod)
-c
-      INTEGER imtmp, jmtmp
-      PARAMETER (imtmp=360,jmtmp=180)
-      REAL xtmp(imtmp), ytmp(jmtmp)
-      REAL(KIND=8) cham1tmp(imtmp,jmtmp), cham2tmp(imtmp,jmtmp)
-      REAL zzzz
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL number(2200,1100)
-c
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-c
-      IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN
-         PRINT*, 'immod ou jmmod trop grand', immod, jmmod
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-c Calculs intermediares:
-c
-      xtmp(1) = -180.0 + 360.0/REAL(imtmp) / 2.0
-      DO i = 2, imtmp
-         xtmp(i) = xtmp(i-1) + 360.0/REAL(imtmp)
-      ENDDO
-      DO i = 1, imtmp
-         xtmp(i) = xtmp(i) /180.0 * 4.0*ATAN(1.0)
-      ENDDO
-      ytmp(1) = -90.0 + 180.0/REAL(jmtmp) / 2.0
-      DO j = 2, jmtmp
-         ytmp(j) = ytmp(j-1) + 180.0/REAL(jmtmp)
-      ENDDO
-      DO j = 1, jmtmp
-         ytmp(j) = ytmp(j) /180.0 * 4.0*ATAN(1.0)
-      ENDDO
-c
-      a(1) = xtmp(1) - (xtmp(2)-xtmp(1))/2.0
-      b(1) = (xtmp(1)+xtmp(2))/2.0
-      DO i = 2, imtmp-1
-         a(i) = b(i-1)
-         b(i) = (xtmp(i)+xtmp(i+1))/2.0
-      ENDDO
-      a(imtmp) = b(imtmp-1)
-      b(imtmp) = xtmp(imtmp) + (xtmp(imtmp)-xtmp(imtmp-1))/2.0
-
-      c(1) = ytmp(1) - (ytmp(2)-ytmp(1))/2.0
-      d(1) = (ytmp(1)+ytmp(2))/2.0
-      DO j = 2, jmtmp-1
-         c(j) = d(j-1)
-         d(j) = (ytmp(j)+ytmp(j+1))/2.0
-      ENDDO
-      c(jmtmp) = d(jmtmp-1)
-      d(jmtmp) = ytmp(jmtmp) + (ytmp(jmtmp)-ytmp(jmtmp-1))/2.0
-
-      DO i = 1, imtmp
-      DO j = 1, jmtmp
-         number(i,j) = 0.0
-         cham1tmp(i,j) = 0.0
-         cham2tmp(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imtmp
-      DO jj = 1, jmtmp
-        DO i = 1, imrel
-         IF( ( xrel(i)-a(ii).GE.1.e-5.AND.xrel(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xrel(i)-a(ii).LE.1.e-5.AND.xrel(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmrel
-          IF( (yrel(j)-c(jj).GE.1.e-5.AND.yrel(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  yrel(j)-c(jj).LE.1.e-5.AND.yrel(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              number(ii,jj) = number(ii,jj) + 1.0
-              cham1tmp(ii,jj) = cham1tmp(ii,jj) + relief(i,j)
-              cham2tmp(ii,jj) = cham2tmp(ii,jj) 
-     .                              + relief(i,j)*relief(i,j)
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-      DO i = 1, imtmp
-      DO j = 1, jmtmp
-         IF (number(i,j) .GT. 0.001) THEN
-         cham1tmp(i,j) = cham1tmp(i,j) / number(i,j)
-         cham2tmp(i,j) = cham2tmp(i,j) / number(i,j)
-         zzzz=cham2tmp(i,j)-cham1tmp(i,j)**2
-         if (zzzz .lt. 0.0) then
-           if (zzzz .gt. -7.5) then
-             zzzz = 0.0
-             print*,'Pb rugsoro, -7.5 < zzzz < 0, => zzz = 0.0'
-           else
-              stop 'Pb rugsoro, zzzz <-7.5'
-           endif
-         endif
-         cham2tmp(i,j) = SQRT(zzzz)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT_GCM("", "", 1)
-         ENDIF
-      ENDDO
-      ENDDO
-c
-      amin = cham2tmp(1,1)
-      AMAX = cham2tmp(1,1)
-      DO j = 1, jmtmp
-      DO i = 1, imtmp
-         IF (cham2tmp(i,j).GT.AMAX) AMAX = cham2tmp(i,j)
-         IF (cham2tmp(i,j).LT.amin) amin = cham2tmp(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Ecart-type 1x1:', amin, AMAX
-c
-c
-c
-      a(1) = xmod(1) - (xmod(2)-xmod(1))/2.0
-      b(1) = (xmod(1)+xmod(2))/2.0
-      DO i = 2, immod-1
-         a(i) = b(i-1)
-         b(i) = (xmod(i)+xmod(i+1))/2.0
-      ENDDO
-      a(immod) = b(immod-1)
-      b(immod) = xmod(immod) + (xmod(immod)-xmod(immod-1))/2.0
-
-      c(1) = ymod(1) - (ymod(2)-ymod(1))/2.0
-      d(1) = (ymod(1)+ymod(2))/2.0
-      DO j = 2, jmmod-1
-         c(j) = d(j-1)
-         d(j) = (ymod(j)+ymod(j+1))/2.0
-      ENDDO
-      c(jmmod) = d(jmmod-1)
-      d(jmmod) = ymod(jmmod) + (ymod(jmmod)-ymod(jmmod-1))/2.0
-c
-      DO i = 1, immod
-      DO j = 1, jmmod
-         number(i,j) = 0.0
-         rugs(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, immod
-      DO jj = 1, jmmod
-        DO i = 1, imtmp
-         IF( ( xtmp(i)-a(ii).GE.1.e-5.AND.xtmp(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xtmp(i)-a(ii).LE.1.e-5.AND.xtmp(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmtmp
-          IF( (ytmp(j)-c(jj).GE.1.e-5.AND.ytmp(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ytmp(j)-c(jj).LE.1.e-5.AND.ytmp(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              number(ii,jj) = number(ii,jj) + 1.0
-              rugs(ii,jj) = rugs(ii,jj)
-     .                       + LOG(MAX(0.001_8,cham2tmp(i,j)))
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-      DO i = 1, immod
-      DO j = 1, jmmod
-         IF (number(i,j) .GT. 0.001) THEN
-         rugs(i,j) = rugs(i,j) / number(i,j)
-         rugs(i,j) = EXP(rugs(i,j))
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-ccc         CALL ABORT_GCM("", "", 1)
-         CALL dist_sphe(xmod(i),ymod(j),xtmp,ytmp,imtmp,jmtmp,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imtmp*jmtmp,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imtmp*jmtmp
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imtmp + 1
-         i_proche = ij_proche - (j_proche-1)*imtmp
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         rugs(i,j) = LOG(MAX(0.001_8,cham2tmp(i_proche,j_proche)))
-         ENDIF
-      ENDDO
-      ENDDO
-c
-      amin = rugs(1,1)
-      AMAX = rugs(1,1)
-      DO j = 1, jmmod
-      DO i = 1, immod
-         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
-         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Ecart-type du modele:', amin, AMAX
-c
-      DO j = 1, jmmod
-      DO i = 1, immod
-         rugs(i,j) = rugs(i,j) / AMAX * 20.0
-      ENDDO
-      ENDDO
-c
-      amin = rugs(1,1)
-      AMAX = rugs(1,1)
-      DO j = 1, jmmod
-      DO i = 1, immod
-         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
-         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Longueur de rugosite du modele:', amin, AMAX
-c
-      RETURN
-      END
-c
-      SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,im,jm,distance)
-c
-c Auteur: Laurent Li (le 30 decembre 1996)
-c
-c Ce programme calcule la distance minimale (selon le grand cercle)
-c entre deux points sur la terre
-c
-c Input:
-      INTEGER im, jm ! dimensions
-      REAL rf_lon ! longitude du point de reference (degres)
-      REAL rf_lat ! latitude du point de reference (degres)
-      REAL rlon(im), rlat(jm) ! longitude et latitude des points
-c
-c Output:
-      REAL distance(im,jm) ! distances en metre
-c
-      REAL rlon1, rlat1
-      REAL rlon2, rlat2
-      REAL dist
-      REAL pa, pb, p, pi
-c
-      REAL radius
-      PARAMETER (radius=6371229.)
-c
-      pi = 4.0 * ATAN(1.0)
-c
-      DO 9999 j = 1, jm
-      DO 9999 i = 1, im
-c
-      rlon1=rf_lon
-      rlat1=rf_lat
-      rlon2=rlon(i)
-      rlat2=rlat(j)
-      pa = pi/2.0 - rlat1*pi/180.0 ! dist. entre pole n et point a
-      pb = pi/2.0 - rlat2*pi/180.0 ! dist. entre pole n et point b
-      p = (rlon1-rlon2)*pi/180.0 ! angle entre a et b (leurs meridiens)
-c
-      dist = ACOS( COS(pa)*COS(pb) + SIN(pa)*SIN(pb)*COS(p))
-      dist = radius * dist
-      distance(i,j) = dist
-c
- 9999 CONTINUE
-c
-      END
Index: LMDZ5/trunk/libf/dyn3dpar/grid_noro.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dpar/grid_noro.F	(revision 1943)
+++ 	(revision )
@@ -1,521 +1,0 @@
-!
-! $Id$
-!
-c
-c
-      SUBROUTINE grid_noro(imdep, jmdep, xdata, ydata, zdata,
-     .             imar, jmar, x, y,
-     .             zphi,zmea,zstd,zsig,zgam,zthe,
-     .             zpic,zval,mask)
-c=======================================================================
-c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
-c
-c      Compute the Parameters of the SSO scheme as described in
-c      LOTT & MILLER (1997) and LOTT(1999).
-c      Target points are on a rectangular grid:
-c      iim+1 latitudes including North and South Poles;
-c      jjm+1 longitudes, with periodicity jjm+1=1.
-c      aux poles.  At the poles the fields value is repeated
-c      jjm+1 time.
-c      The parameters a,b,c,d represent the limite of the target
-c      gridpoint region. The means over this region are calculated
-c      from USN data, ponderated by a weight proportional to the 
-c      surface occupated by the data inside the model gridpoint area.
-c      In most circumstances, this weight is the ratio between the
-c      surface of the USN gridpoint area and the surface of the
-c      model gridpoint area. 
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X and Y input field
-c        xdata, ydata: coordinates X and Y input field
-c        zdata: Input field
-c        In this version it is assumed that the entry data come from
-c        the USNavy dataset: imdep=iusn=2160, jmdep=jusn=1080.
-c OUTPUT:
-c        imar, jmar: dimensions X and Y Output field
-c        x, y: ccordinates  X and Y Output field.
-c             zmea:  Mean orographie   
-c             zstd:  Standard deviation
-c             zsig:  Slope
-c             zgam:  Anisotropy
-c             zthe:  Orientation of the small axis
-c             zpic:  Maximum altitude
-c             zval:  Minimum altitude
-C=======================================================================
-
-      IMPLICIT INTEGER (I,J)
-      IMPLICIT REAL(X,Z) 
-      
-	  parameter(iusn=2160,jusn=1080,iext=216, epsfra = 1.e-5)
-#include "dimensions.h"
-	  REAL xusn(iusn+2*iext),yusn(jusn+2)	
-      REAL zusn(iusn+2*iext,jusn+2)
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL zdata(imdep,jmdep)
-c
-      INTEGER imar, jmar
-  
-C INTERMEDIATE FIELDS  (CORRELATIONS OF OROGRAPHY GRADIENT)
-
-      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
-      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
-      REAL weight(iim+1,jjm+1)
-
-C CORRELATIONS OF USN OROGRAPHY GRADIENTS
-
-      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
-      REAL zxtzyusn(iusn+2*iext,jusn+2)
-      REAL x(imar+1),y(jmar),zphi(imar+1,jmar)
-      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
-      REAL zmea0(imar+1,jmar) ! GK211005 (CG)
-      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
-      REAL zpic(imar+1,jmar),zval(imar+1,jmar)
-cxxx PB     integer mask(imar+1,jmar)
-      real mask(imar+1,jmar), mask_tmp(imar+1,jmar)
-      real num_tot(2200,1100),num_lan(2200,1100)
-c
-      REAL a(2200),b(2200),c(1100),d(1100)
-      logical masque_lu
-c
-      print *,' parametres de l orographie a l echelle sous maille' 
-      xpi=acos(-1.)
-      rad    = 6 371 229.
-      zdeltay=2.*xpi/REAL(jusn)*rad
-c
-c utilise-t'on un masque lu?
-c
-      masque_lu = .true.
-      if (maxval(mask) == -99999 .and. minval(mask) == -99999) then
-        masque_lu= .false.
-        masque = 0.0
-      endif
-      write(*,*)'Masque lu', masque_lu
-c
-c  quelques tests de dimensions:
-c    
-c
-      if(iim.ne.imar) STOP 'Problem dim. x'
-      if(jjm.ne.jmar-1) STOP 'Problem dim. y'
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar or jmar too big', imar, jmar
-         CALL ABORT
-      ENDIF
-
-      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
-         print *,' imdep or jmdep bad dimensions:',imdep,jmdep
-         call abort
-      ENDIF
-
-      IF(imar+1.ne.iim+1.or.jmar.ne.jjm+1)THEN
-        print *,' imar or jmar bad dimensions:',imar,jmar
-        call abort
-      ENDIF
-
-
-c      print *,'xdata:',xdata
-c      print *,'ydata:',ydata
-c      print *,'x:',x
-c      print *,'y:',y
-c
-C  EXTENSION OF THE USN DATABASE TO POCEED COMPUTATIONS AT
-C  BOUNDARIES:
-c
-      DO j=1,jusn
-        yusn(j+1)=ydata(j)
-      DO i=1,iusn
-        zusn(i+iext,j+1)=zdata(i,j)
-        xusn(i+iext)=xdata(i)
-      ENDDO
-      DO i=1,iext
-        zusn(i,j+1)=zdata(iusn-iext+i,j)
-        xusn(i)=xdata(iusn-iext+i)-2.*xpi
-        zusn(iusn+iext+i,j+1)=zdata(i,j)
-        xusn(iusn+iext+i)=xdata(i)+2.*xpi
-      ENDDO
-      ENDDO
-
-        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
-        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
-       DO i=1,iusn/2+iext
-        zusn(i,1)=zusn(i+iusn/2,2)
-        zusn(i+iusn/2+iext,1)=zusn(i,2)
-        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
-        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
-       ENDDO
-c  
-c COMPUTE LIMITS OF MODEL GRIDPOINT AREA
-C     ( REGULAR GRID)
-c
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar+1) = b(imar)
-      b(imar+1) = x(imar+1) + (x(imar+1)-x(imar))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-c
-c  initialisations:
-c
-      DO i = 1, imar+1
-      DO j = 1, jmar
-         weight(i,j) = 0.0
-         zxtzx(i,j)  = 0.0
-         zytzy(i,j)  = 0.0
-         zxtzy(i,j)  = 0.0
-         ztz(i,j)    = 0.0
-         zmea(i,j)   = 0.0
-         zpic(i,j)  =-1.E+10
-         zval(i,j)  = 1.E+10
-      ENDDO
-      ENDDO
-c
-c  COMPUTE SLOPES CORRELATIONS ON USN GRID
-c
-         DO j = 1,jusn+2 
-         DO i = 1, iusn+2*iext
-            zytzyusn(i,j)=0.0
-            zxtzxusn(i,j)=0.0
-            zxtzyusn(i,j)=0.0
-         ENDDO
-         ENDDO
-
-
-         DO j = 2,jusn+1 
-            zdeltax=zdeltay*cos(yusn(j))
-         DO i = 2, iusn+2*iext-1
-            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
-            zxtzxusn(i,j)=(zusn(i+1,j)-zusn(i-1,j))**2/zdeltax**2
-            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
-     *                   *(zusn(i+1,j)-zusn(i-1,j))/zdeltax
-         ENDDO
-         ENDDO
-c
-c  SUMMATION OVER GRIDPOINT AREA
-c 
-      zleny=xpi/REAL(jusn)*rad
-      xincr=xpi/2./REAL(jusn)
-       DO ii = 1, imar+1
-       DO jj = 1, jmar
-       num_tot(ii,jj)=0.
-       num_lan(ii,jj)=0.
-c        PRINT *,' iteration ii jj:',ii,jj
-         DO j = 2,jusn+1 
-c         DO j = 3,jusn 
-            zlenx=zleny*cos(yusn(j))
-            zdeltax=zdeltay*cos(yusn(j))
-            zbordnor=(c(jj)-yusn(j)+xincr)*rad
-            zbordsud=(yusn(j)-d(jj)+xincr)*rad
-            weighy=AMAX1(0.,
-     *             amin1(zbordnor,zbordsud,zleny))
-         IF(weighy.ne.0)THEN
-         DO i = 2, iusn+2*iext-1
-            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
-            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
-            weighx=AMAX1(0.,
-     *             amin1(zbordest,zbordoue,zlenx))
-            IF(weighx.ne.0)THEN
-            num_tot(ii,jj)=num_tot(ii,jj)+1.0
-            if(zusn(i,j).ge.1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
-            weight(ii,jj)=weight(ii,jj)+weighx*weighy
-            zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
-            zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
-            zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
-            ztz(ii,jj)  =ztz(ii,jj)  +zusn(i,j)*zusn(i,j)*weighx*weighy
-c mean
-            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
-c peacks
-            zpic(ii,jj)=amax1(zpic(ii,jj),zusn(i,j))
-c valleys
-            zval(ii,jj)=amin1(zval(ii,jj),zusn(i,j))
-            ENDIF
-         ENDDO
-         ENDIF
-         ENDDO
-       ENDDO
-       ENDDO
-c
-c  COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND
-C  LOTT (1999) SSO SCHEME.
-c
-      zllmmea=0.
-      zllmstd=0.
-      zllmsig=0.
-      zllmgam=0.
-      zllmpic=0.
-      zllmval=0.
-      zllmthe=0.
-      zminthe=0.
-c     print 100,' '
-c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
-       DO ii = 1, imar+1
-       DO jj = 1, jmar
-         IF (weight(ii,jj) .NE. 0.0) THEN
-c  Mask
-cXXX           if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
-cXXX             mask(ii,jj)=1
-cXXX           else
-cXXX             mask(ii,jj)=0
-cXXX           ENDIF
-             if (.not. masque_lu) then
-               mask(ii,jj) = num_lan(ii,jj)/num_tot(ii,jj)
-             endif
-c  Mean Orography:
-           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
-           zxtzx(ii,jj)=zxtzx(ii,jj)/weight(ii,jj)
-           zytzy(ii,jj)=zytzy(ii,jj)/weight(ii,jj)
-           zxtzy(ii,jj)=zxtzy(ii,jj)/weight(ii,jj)
-           ztz(ii,jj)  =ztz(ii,jj)/weight(ii,jj)
-c  Standard deviation:
-           zstd(ii,jj)=sqrt(AMAX1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
-         ELSE
-            PRINT*, 'probleme,ii,jj=', ii,jj
-         ENDIF
-       ENDDO
-       ENDDO
-
-C CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES:
-
-       DO ii = 1, imar+1
-         zxtzx(ii,1)=zxtzx(ii,2)
-         zxtzx(ii,jmar)=zxtzx(ii,jmar-1)
-         zxtzy(ii,1)=zxtzy(ii,2)
-         zxtzy(ii,jmar)=zxtzy(ii,jmar-1)
-         zytzy(ii,1)=zytzy(ii,2)
-         zytzy(ii,jmar)=zytzy(ii,jmar-1)
-       ENDDO
-
-C  FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME.
-
-C  FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
-
-       zmea0(:,:) = zmea(:,:) ! GK211005 (CG) on sauvegarde la topo non lissee
-       CALL MVA9(zmea,iim+1,jjm+1)
-       CALL MVA9(zstd,iim+1,jjm+1)
-       CALL MVA9(zpic,iim+1,jjm+1)
-       CALL MVA9(zval,iim+1,jjm+1)
-       CALL MVA9(zxtzx,iim+1,jjm+1)
-       CALL MVA9(zxtzy,iim+1,jjm+1) 
-       CALL MVA9(zytzy,iim+1,jjm+1)
-CXXX   Masque prenant en compte maximum de terre
-CXXX  On seuil a 10% de terre de terre car en dessous les parametres de surface n'on
-CXXX pas de sens (PB)
-       mask_tmp= 0.0
-       WHERE(mask .GE. 0.1) mask_tmp = 1.
-
-       DO ii = 1, imar
-       DO jj = 1, jmar
-         IF (weight(ii,jj) .NE. 0.0) THEN
-c  Coefficients K, L et M:
-           xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
-           xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
-           xm=zxtzy(ii,jj)
-           xp=xk-sqrt(xl**2+xm**2)
-           xq=xk+sqrt(xl**2+xm**2)
-           xw=1.e-8
-           if(xp.le.xw) xp=0.
-           if(xq.le.xw) xq=xw
-           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
-c slope: 
-cXXX           zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
-cXXXc isotropy:
-cXXX           zgam(ii,jj)=xp/xq*mask(ii,jj)
-cXXXc angle theta:
-cXXX           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
-cXXX           zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
-cXXX           zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
-cXXX           zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
-cXXX           zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
-cXXX           zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
-CXX* PB modif pour maque de terre fractionnaire
-c slope: 
-           zsig(ii,jj)=sqrt(xq)*mask_tmp(ii,jj)
-c isotropy:
-           zgam(ii,jj)=xp/xq*mask_tmp(ii,jj)
-c angle theta:
-           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask_tmp(ii,jj)
-           ! GK211005 (CG) ne pas forcement lisser la topo
-           ! zphi(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
-           zphi(ii,jj)=zmea0(ii,jj)*mask_tmp(ii,jj)
-           !
-           zmea(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
-           zpic(ii,jj)=zpic(ii,jj)*mask_tmp(ii,jj)
-           zval(ii,jj)=zval(ii,jj)*mask_tmp(ii,jj)
-           zstd(ii,jj)=zstd(ii,jj)*mask_tmp(ii,jj)
-c          print 101,ii,jj,
-c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
-c    *           zthe(ii,jj)
-c101  format(1x,2(1x,i2),2(1x,f7.1),1x,f7.4,2x,f4.2,1x,f5.1)     
-         ELSE
-c           PRINT*, 'probleme,ii,jj=', ii,jj
-         ENDIF
-      zllmmea=AMAX1(zmea(ii,jj),zllmmea)
-      zllmstd=AMAX1(zstd(ii,jj),zllmstd)
-      zllmsig=AMAX1(zsig(ii,jj),zllmsig)
-      zllmgam=AMAX1(zgam(ii,jj),zllmgam)
-      zllmthe=AMAX1(zthe(ii,jj),zllmthe)
-      zminthe=amin1(zthe(ii,jj),zminthe)
-      zllmpic=AMAX1(zpic(ii,jj),zllmpic)
-      zllmval=AMAX1(zval(ii,jj),zllmval)
-       ENDDO
-       ENDDO
-      print *,'  MEAN ORO:',zllmmea
-      print *,'  ST. DEV.:',zllmstd
-      print *,'  PENTE:',zllmsig
-      print *,' ANISOTROP:',zllmgam
-      print *,'  ANGLE:',zminthe,zllmthe	
-      print *,'  pic:',zllmpic
-      print *,'  val:',zllmval
-      
-C
-c gamma and theta a 1. and 0. at poles
-c
-      DO jj=1,jmar
-      zmea(imar+1,jj)=zmea(1,jj)
-      zphi(imar+1,jj)=zphi(1,jj)
-      zpic(imar+1,jj)=zpic(1,jj)
-      zval(imar+1,jj)=zval(1,jj)
-      zstd(imar+1,jj)=zstd(1,jj)
-      zsig(imar+1,jj)=zsig(1,jj)
-      zgam(imar+1,jj)=zgam(1,jj)
-      zthe(imar+1,jj)=zthe(1,jj)
-      ENDDO
-
-
-      zmeanor=0.0
-      zmeasud=0.0
-      zstdnor=0.0
-      zstdsud=0.0
-      zsignor=0.0
-      zsigsud=0.0
-      zweinor=0.0
-      zweisud=0.0
-      zpicnor=0.0
-      zpicsud=0.0                                   
-      zvalnor=0.0
-      zvalsud=0.0 
-
-      DO ii=1,imar
-      zweinor=zweinor+              weight(ii,   1)
-      zweisud=zweisud+              weight(ii,jmar)
-      zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)
-      zmeasud=zmeasud+zmea(ii,jmar)*weight(ii,jmar)
-      zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)
-      zstdsud=zstdsud+zstd(ii,jmar)*weight(ii,jmar)
-      zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)
-      zsigsud=zsigsud+zsig(ii,jmar)*weight(ii,jmar)
-      zpicnor=zpicnor+zpic(ii,   1)*weight(ii,   1)
-      zpicsud=zpicsud+zpic(ii,jmar)*weight(ii,jmar)
-      zvalnor=zvalnor+zval(ii,   1)*weight(ii,   1)
-      zvalsud=zvalsud+zval(ii,jmar)*weight(ii,jmar)
-      ENDDO
-
-      DO ii=1,imar+1
-      zmea(ii,   1)=zmeanor/zweinor
-      zmea(ii,jmar)=zmeasud/zweisud
-      zphi(ii,   1)=zmeanor/zweinor
-      zphi(ii,jmar)=zmeasud/zweisud
-      zpic(ii,   1)=zpicnor/zweinor
-      zpic(ii,jmar)=zpicsud/zweisud
-      zval(ii,   1)=zvalnor/zweinor
-      zval(ii,jmar)=zvalsud/zweisud
-      zstd(ii,   1)=zstdnor/zweinor
-      zstd(ii,jmar)=zstdsud/zweisud
-      zsig(ii,   1)=zsignor/zweinor
-      zsig(ii,jmar)=zsigsud/zweisud
-      zgam(ii,   1)=1.
-      zgam(ii,jmar)=1.
-      zthe(ii,   1)=0.
-      zthe(ii,jmar)=0.
-      ENDDO
-
-      RETURN
-      END
-
-      SUBROUTINE MVA9(X,IMAR,JMAR)
-
-C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
-
-      REAL X(IMAR,JMAR),XF(IMAR,JMAR)
-      real WEIGHTpb(-1:1,-1:1)
-
-      
-      SUM=0.
-      DO IS=-1,1
-        DO JS=-1,1
-          WEIGHTpb(IS,JS)=1./REAL((1+IS**2)*(1+JS**2))
-          SUM=SUM+WEIGHTpb(IS,JS)
-        ENDDO
-      ENDDO
-      
-c     WRITE(*,*) 'MVA9 ', IMAR, JMAR
-c     WRITE(*,*) 'MVA9 ', WEIGHTpb
-c     WRITE(*,*) 'MVA9 SUM ', SUM
-      DO IS=-1,1
-        DO JS=-1,1
-          WEIGHTpb(IS,JS)=WEIGHTpb(IS,JS)/SUM
-        ENDDO
-      ENDDO
-
-      DO J=2,JMAR-1
-        DO I=2,IMAR-1
-          XF(I,J)=0.
-          DO IS=-1,1
-            DO JS=-1,1
-              XF(I,J)=XF(I,J)+X(I+IS,J+JS)*WEIGHTpb(IS,JS)
-            ENDDO
-          ENDDO
-        ENDDO
-      ENDDO
-
-      DO J=2,JMAR-1
-        XF(1,J)=0.
-        IS=IMAR-1
-        DO JS=-1,1 
-          XF(1,J)=XF(1,J)+X(IS,J+JS)*WEIGHTpb(-1,JS)
-        ENDDO
-        DO IS=0,1 
-          DO JS=-1,1 
-            XF(1,J)=XF(1,J)+X(1+IS,J+JS)*WEIGHTpb(IS,JS)
-          ENDDO
-        ENDDO
-        XF(IMAR,J)=XF(1,J)
-      ENDDO
-
-      DO I=1,IMAR
-        XF(I,1)=XF(I,2)
-        XF(I,JMAR)=XF(I,JMAR-1)
-      ENDDO
-
-      DO I=1,IMAR
-        DO J=1,JMAR
-          X(I,J)=XF(I,J)
-        ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
Index: LMDZ5/trunk/libf/dyn3dpar/juldate.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dpar/juldate.F	(revision 1943)
+++ 	(revision )
@@ -1,33 +1,0 @@
-!
-! $Header$
-!
-	subroutine juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec)
-c	Sous-routine de changement de date:
-c	gregorien>>>date julienne
-c	En entree:an,mois,jour,heure,min.,sec.
-c	En sortie:tjd
-	implicit real (a-h,o-z)
-	frac=((os/60.+om)/60.+oh)/24.
-	ojou=dfloat(ijou)+frac
-	    year=dfloat(ian)
-	    rmon=dfloat(imoi)
-	if (imoi .le. 2) then
-	    year=year-1.
-	    rmon=rmon+12.
-	endif
-	cf=year+(rmon/100.)+(ojou/10000.)
-	if (cf .ge. 1582.1015) then
-	    a=int(year/100)
-	    b=2-a+int(a/4)
-	else
-	    b=0
-	endif
-	tjd=int(365.25*year)+int(30.6001*(rmon+1))+int(ojou)
-     +   +1720994.5+b
-        tjdsec=(ojou-int(ojou))+(tjd-int(tjd))
-        tjd=int(tjd)+int(tjdsec)
-	tjdsec=tjdsec-int(tjdsec)
-	return
-	end
-
-
Index: LMDZ5/trunk/libf/dyn3dpar/pres2lev_mod.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3dpar/pres2lev_mod.F90	(revision 1943)
+++ 	(revision )
@@ -1,80 +1,0 @@
-! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $
-!
-MODULE pres2lev_mod
-
-CONTAINS 
-
-!******************************************************
-SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn,ni,nj,ok_invertp)
-!
-! interpolation lineaire pour passer
-! a une nouvelle discretisation verticale pour
-! les variables de GCM
-! Francois Forget (01/1995)
-! MOdif remy roca 12/97 pour passer de pres2sig
-! Modif F.Codron 07/08 po en 3D
-!**********************************************************
-
-  IMPLICIT NONE
-
-!   Declarations:
-! ==============
-!
-!  ARGUMENTS
-!  """""""""
-  LOGICAL, INTENT(IN) :: ok_invertp
-  INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
-  INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
-  
-  REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille
-  REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille
-
-  INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
-
-  REAL, INTENT(IN)  :: varo(ni*nj,lmo) ! var dans l'ancienne grille
-  REAL, INTENT(OUT) :: varn(ni*nj,lmn) ! var dans la nouvelle grille
-
-  REAL :: zvaro(ni*nj,lmo),zpo(ni*nj,lmo)
-
-! Autres variables
-! """"""""""""""""
-  INTEGER ::  ln ,lo, k
-  REAL    :: coef
-
-
-! Inversion de l'ordre des niveaux verticaux
-  IF (ok_invertp) THEN
-    DO lo=1,lmo
-      DO k=1,ni*nj
-        zpo(k,lo)=po(k,lmo+1-lo)
-        zvaro(k,lo)=varo(k,lmo+1-lo)
-      ENDDO
-    ENDDO
-  ELSE
-    DO lo=1,lmo
-      DO k=1,ni*nj
-        zpo(k,lo)=po(k,lo)
-        zvaro(k,lo)=varo(k,lo)
-      ENDDO
-    ENDDO
-  ENDIF 
-
-  DO ln=1,lmn
-    DO lo=1,lmo-1
-      DO k=1,ni*nj
-        IF (pn(k,ln) >= zpo(k,1) ) THEN
-          varn(k,ln) = zvaro(k,1)
-        ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN
-          varn(k,ln) = zvaro(k,lmo)
-        ELSE IF ( pn(k,ln) <= zpo(k,lo) .AND. pn(k,ln) > zpo(k,lo+1) ) THEN
-          coef = (pn(k,ln)-zpo(k,lo)) / (zpo(k,lo+1)-zpo(k,lo))
-          varn(k,ln) = zvaro(k,lo) + coef*(zvaro(k,lo+1)-zvaro(k,lo))
-        ENDIF
-         
-      ENDDO  
-    ENDDO
-  ENDDO                
-
-END SUBROUTINE pres2lev    
-
-END MODULE pres2lev_mod
Index: LMDZ5/trunk/libf/dyn3dpar/ran1.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dpar/ran1.F	(revision 1943)
+++ 	(revision )
@@ -1,34 +1,0 @@
-!
-! $Id$
-!
-      FUNCTION RAN1(IDUM)
-      DIMENSION R(97)
-      save r
-      save iff,ix1,ix2,ix3
-      PARAMETER (M1=259200,IA1=7141,IC1=54773,RM1=3.8580247E-6)
-      PARAMETER (M2=134456,IA2=8121,IC2=28411,RM2=7.4373773E-6)
-      PARAMETER (M3=243000,IA3=4561,IC3=51349)
-      DATA IFF /0/
-      IF (IDUM.LT.0.OR.IFF.EQ.0) THEN
-        IFF=1
-        IX1=MOD(IC1-IDUM,M1)
-        IX1=MOD(IA1*IX1+IC1,M1)
-        IX2=MOD(IX1,M2)
-        IX1=MOD(IA1*IX1+IC1,M1)
-        IX3=MOD(IX1,M3)
-        DO 11 J=1,97
-          IX1=MOD(IA1*IX1+IC1,M1)
-          IX2=MOD(IA2*IX2+IC2,M2)
-          R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
-11      CONTINUE
-        IDUM=1
-      ENDIF
-      IX1=MOD(IA1*IX1+IC1,M1)
-      IX2=MOD(IA2*IX2+IC2,M2)
-      IX3=MOD(IA3*IX3+IC3,M3)
-      J=1+(97*IX3)/M3
-      IF(J.GT.97.OR.J.LT.1) stop 1
-      RAN1=R(J)
-      R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
-      RETURN
-      END
Index: LMDZ5/trunk/makegcm
===================================================================
--- LMDZ5/trunk/makegcm	(revision 1943)
+++ LMDZ5/trunk/makegcm	(revision 1944)
@@ -10,5 +10,5 @@
 set physique=lmd
 set phys="PHYS=$physique"
-set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I$(LIBF)/filtrez -I. '
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I$(LIBF)/dyn3d_common -I$(LIBF)/filtrez -I. '
 set filtre=filtrez
 set grille=reg
Index: LMDZ5/trunk/makelmdz
===================================================================
--- LMDZ5/trunk/makelmdz	(revision 1943)
+++ LMDZ5/trunk/makelmdz	(revision 1944)
@@ -83,5 +83,5 @@
 
 CPP_KEY="" 
-INCLUDE='-I$(LIBF)/grid -I$(LIBF)/bibio -I$(LIBF)/filtrez -I. '
+INCLUDE='-I$(LIBF)/grid -I$(LIBF)/bibio -I$(LIBF)/dyn3d_common -I$(LIBF)/filtrez -I. '
 LIB=""
 adjnt=""
Index: LMDZ5/trunk/tools/install_1d_src.sh
===================================================================
--- LMDZ5/trunk/tools/install_1d_src.sh	(revision 1943)
+++ LMDZ5/trunk/tools/install_1d_src.sh	(revision 1944)
@@ -42,5 +42,5 @@
  ln -s ../dyn3d/infotrac.F90 .
  ln -s ../dyn3d/conf_gcm.F .
- ln -s ../dyn3d/pres2lev* .
+ ln -s ../dyn3d_common/pres2lev* .
  ln -s ../dyn3d/control_mod.F90 .
  ln -s ../dyn3d/q_sat.F .
