*=*=*=*= testadjnt.html =*=*=*=*
PROGRAM testadjnt

PROGRAM testadjnt


      PROGRAM testadjnt
      IMPLICIT NONE

c=======================================================================
c
c   Auteur:  P. Le Van/ L.Fairhead/F.Hourdin
c   -------
c   Modif special traceur F.Forget 05/94
c
c   Objet:
c   ------
c
c   GCM LMD nouvelle grille
c
c=======================================================================

c   ... modification de l'integration de q ( 26/04/94 ) ....

c-----------------------------------------------------------------------
c   Declarations:
c   -------------

#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"
#include "comdissip.h"
#include "comvert.h"
#include "comgeom.h"
#include "logic.h"
#include "temps.h"
#include "control.h"
#include "ener.h"
#include "drsdef.h"
#include "description.h"

      INTEGER*4  iday ! jour julien
      REAL       time ! Heure de la journee en fraction d'1 jour
      REAL zdtvr,eps,zeps,resi
      INTEGER nbetatmoy, nbetatdem,nbetat,itau
      INTEGER ierr, aslun, cllun

      INTEGER ij,l,i,izz


      REAL ssum,sum,phis(ip1jmp1)

c variables dynamiques intermediaire pour le transport
      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),h(ip1jmp1,llm)
      REAL pext(ip1jmp1),pks(ip1jmp1),pksf(ip1jmp1)
      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
      REAL phi(ip1jmp1,llm)
      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
      REAL Mang(ip1jmp1,llm)
      REAL pbarx(ip1jmp1),pbary(ip1jm),pbarxy(ip1jm)
      REAL vorpot(ip1jm,llm)
      REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
      REAL bern(ip1jmp1,llm)
c variables dynamiques intermediaire pour le transport
      REAL vcov_d(ip1jm,llm),ucov_d(ip1jmp1,llm),h_d(ip1jmp1,llm)
      REAL pext_d(ip1jmp1),pks_d(ip1jmp1)
      REAL pksf_d(ip1jmp1)
      REAL vcont_d(ip1jm,llm),ucont_d(ip1jmp1,llm)
      REAL phi_d(ip1jmp1,llm)
      REAL dv_d(ip1jm,llm),du_d(ip1jmp1,llm)
      REAL dh_d(ip1jmp1,llm),dp_d(ip1jmp1)
      REAL pbaru_d(ip1jmp1,llm),pbarv_d(ip1jm,llm)
      REAL Mang_d(ip1jmp1,llm)
      REAL pbarx_d(ip1jmp1),pbary_d(ip1jm),pbarxy_d(ip1jm)
      REAL vorpot_d(ip1jm,llm)
      REAL w_d(ip1jmp1,llm),ecin_d(ip1jmp1,llm),convm_d(ip1jmp1,llm)
      REAL bern_d(ip1jmp1,llm)
c variables dynamiques intermediaire pour le transport
      REAL vcov_g(ip1jm,llm),ucov_g(ip1jmp1,llm),h_g(ip1jmp1,llm)
      REAL pext_g(ip1jmp1),pks_g(ip1jmp1)
      REAL pksf_g(ip1jmp1)
      REAL vcont_g(ip1jm,llm),ucont_g(ip1jmp1,llm)
      REAL phi_g(ip1jmp1,llm)
      REAL dv_g(ip1jm,llm),du_g(ip1jmp1,llm)
      REAL dh_g(ip1jmp1,llm),dp_g(ip1jmp1)
      REAL pbaru_g(ip1jmp1,llm),pbarv_g(ip1jm,llm)
      REAL Mang_g(ip1jmp1,llm)
      REAL pbarx_g(ip1jmp1),pbary_g(ip1jm),pbarxy_g(ip1jm)
      REAL vorpot_g(ip1jm,llm)
      REAL w_g(ip1jmp1,llm),ecin_g(ip1jmp1,llm),convm_g(ip1jmp1,llm)
      REAL bern_g(ip1jmp1,llm)
c variables dynamiques intermediaire pour le transport
      REAL vcov_0(ip1jm,llm),ucov_0(ip1jmp1,llm),h_0(ip1jmp1,llm)
      REAL pext_0(ip1jmp1),pks_0(ip1jmp1)
      REAL pksf_0(ip1jmp1)
      REAL vcont_0(ip1jm,llm),ucont_0(ip1jmp1,llm)
      REAL phi_0(ip1jmp1,llm)
      REAL dv_0(ip1jm,llm),du_0(ip1jmp1,llm)
      REAL dh_0(ip1jmp1,llm),dp_0(ip1jmp1)
      REAL pbaru_0(ip1jmp1,llm),pbarv_0(ip1jm,llm)
      REAL Mang_0(ip1jmp1,llm)
      REAL pbarx_0(ip1jmp1),pbary_0(ip1jm),pbarxy_0(ip1jm)
      REAL vorpot_0(ip1jm,llm)
      REAL w_0(ip1jmp1,llm),ecin_0(ip1jmp1,llm),convm_0(ip1jmp1,llm)
      REAL bern_0(ip1jmp1,llm)
c facteurs de normalisation pour la fonction J
      REAL z_vcov(ip1jm,llm),z_ucov(ip1jmp1,llm),z_h(ip1jmp1,llm)
      REAL z_pext(ip1jmp1),z_pks(ip1jmp1)
      REAL z_pksf(ip1jmp1)
      REAL z_vcont(ip1jm,llm),z_ucont(ip1jmp1,llm)
      REAL z_phi(ip1jmp1,llm)
      REAL z_dv(ip1jm,llm),z_du(ip1jmp1,llm)
      REAL z_dh(ip1jmp1,llm),z_dp(ip1jmp1)
      REAL z_pbaru(ip1jmp1,llm),z_pbarv(ip1jm,llm)
      REAL z_Mang(ip1jmp1,llm)
      REAL z_pbarx(ip1jmp1),z_pbary(ip1jm),z_pbarxy(ip1jm)
      REAL z_vorpot(ip1jm,llm)
      REAL z_w(ip1jmp1,llm),z_ecin(ip1jmp1,llm),z_convm(ip1jmp1,llm)
      REAL z_bern(ip1jmp1,llm)


      INTEGER i_vcov,i_ucov,i_h
      INTEGER i_pext,i_pks
      INTEGER i_pksf
      INTEGER i_vcont,i_ucont
      INTEGER i_phi
      INTEGER i_dv,i_du
      INTEGER i_dh,i_dp
      INTEGER i_pbaru,i_pbarv
      INTEGER i_Mang
      INTEGER i_pbarx,i_pbary,i_pbarxy
      INTEGER i_vorpot
      INTEGER i_w,i_ecin,i_convm
      INTEGER i_bern

      INTEGER j_vcov,j_ucov,j_h
      INTEGER j_pext,j_pks
      INTEGER j_pksf
      INTEGER j_vcont,j_ucont
      INTEGER j_phi
      INTEGER j_dv,j_du
      INTEGER j_dh,j_dp
      INTEGER j_pbaru,j_pbarv
      INTEGER j_Mang
      INTEGER j_pbarx,j_pbary,j_pbarxy
      INTEGER j_vorpot
      INTEGER j_w,j_ecin,j_convm
      INTEGER j_bern

c   fonctions de test
      INTEGER njmx
      parameter (njmx=ip1jmp1*5*llm)
      INTEGER nj,njm
      REAL fj0(2),dj(njmx),fj,djdx
      INTEGER ialpha
      REAL zz

      INTEGER idum
      REAL ran1,xx

      itau=1

      idum=-1
      xx=ran1(idum)
      idum=0


      j_vcov=0
      j_ucov=0
      j_h=0
      j_pext=0
      j_pks=0
      j_pksf=0
      j_vcont=0
      j_ucont=0
      j_phi=0
      j_dv=0
      j_du=0
      j_dh=0
      j_dp=0
      j_pbaru=0
      j_pbarv=0
      j_Mang=0
      j_pbarx=0
      j_pbary=0
      j_pbarxy=0
      j_vorpot=0
      j_w=0
      j_ecin=0
      j_convm=0
      j_bern=0

      i_vcov=0
      i_ucov=0
      i_h=0
      i_pext=0
      i_pks=0
      i_pksf=0
      i_vcont=0
      i_ucont=0
      i_phi=0
      i_dv=0
      i_du=0
      i_dh=0
      i_dp=0
      i_pbaru=0
      i_pbarv=0
      i_Mang=0
      i_pbarx=0
      i_pbary=0
      i_pbarxy=0
      i_vorpot=0
      i_w=0
      i_ecin=0
      i_convm=0
      i_bern=0

#include "adj.io.h"

c-----------------------------------------------------------------------
c   Initialisations:
c   ----------------

      rad = 6400000.
      omeg = 1.e-5
      g = 10.
      mugaz = 28.
      kappa = 0.25
      daysec = 86400.
      dtvr = 500.
      dtdiss=dtvr*5.
      tetavel  = 30000.
      tetatemp = 30000.
      niterdis = 1
      lstardis = .FALSE.


c-----------------------------------------------------------------------

      CALL defrun(5)
      CALL iniconst
      CALL inigeom
      call inifilr
      print*,'INIFILR OK'
      CALL inidissip(lstardis,niterdis,tetavel,tetatemp)
      print*,'INIDISSIP OK'

c-----------------------------------------------------------------------
c   calcul de la precision de la machine:
c   -------------------------------------

      zeps=1.
      do while(1.+zeps.ne.1.)
         eps=zeps
         zeps=zeps/2.
      enddo
      write(67,*)
      write(67,*) 'eps',eps,zeps
      write(67,*) '(eps+1.)-1. =',(eps+1.)-1.
      write(67,*) '(eps/2+1.)-1. =',(zeps+1.)-1.
      write(67,*)
      zeps=1.+eps

      do i=1,2

c-----------------------------------------------------------------------
c   calcul de la fonction J sur l'etat de base:
c   -------------------------------------------


      print*,'DEBUT INITESTADJ'
      call initestadj(phis,
     .  vcov,ucov,h,pext,pks,pksf,vcont,ucont
     . ,phi,dv,du,dh,dp,pbaru,pbarv,Mang
     . ,pbarx,pbary,pbarxy,vorpot,w,ecin,convm,bern
     . ,z_vcov,z_ucov,z_h,z_pext,z_pks,z_pksf,z_vcont,z_ucont
     . ,z_phi,z_dv,z_du,z_dh,z_dp,z_pbaru,z_pbarv,z_Mang
     . ,z_pbarx,z_pbary,z_pbarxy,z_vorpot,z_w,z_ecin,z_convm,z_bern
     . ,i-1,zeps)
      print*,'INTESTADJ OK'

      if(i.eq.1) then
      call scopy(ijp1llm,ucov,1,ucov_0,1)
      call scopy(ijp1llm,h,1,h_0,1)
      call scopy(ijp1llm,ucont,1,ucont_0,1)
      call scopy(ijp1llm,phi,1,phi_0,1)
      call scopy(ijp1llm,du,1,du_0,1)
      call scopy(ijp1llm,dh,1,dh_0,1)
      call scopy(ijp1llm,Mang,1,Mang_0,1)
      call scopy(ijp1llm,pbaru,1,pbaru_0,1)
      call scopy(ijp1llm,w,1,w_0,1)
      call scopy(ijp1llm,ecin,1,ecin_0,1)
      call scopy(ijp1llm,convm,1,convm_0,1)
      call scopy(ijp1llm,bern,1,bern_0,1)
      call scopy(ijmllm,vcov,1,vcov_0,1)
      call scopy(ijmllm,vcont,1,vcont_0,1)
      call scopy(ijmllm,dv,1,dv_0,1)
      call scopy(ijmllm,pbarv,1,pbarv_0,1)
      call scopy(ijmllm,vorpot,1,vorpot_0,1)
      call scopy(ip1jmp1,pext,1,pext_0,1)
      call scopy(ip1jmp1,pks,1,pks_0,1)
      call scopy(ip1jmp1,pksf,1,pksf_0,1)
      call scopy(ip1jmp1,dp,1,dp_0,1)
      call scopy(ip1jmp1,pbarx,1,pbarx_0,1)
      call scopy(ip1jm,pbary,1,pbary_0,1)
      call scopy(ip1jm,pbarxy,1,pbarxy_0,1)
      endif

#include "adj.direct.h"

      print*,'FONCJ0 ',i
      call foncj(
     .  j_vcov,j_ucov,j_h,j_pext,j_pks,j_pksf,j_vcont,j_ucont
     . ,j_phi,j_dv,j_du,j_dh,j_dp,j_pbaru,j_pbarv,j_Mang
     . ,j_pbarx,j_pbary,j_pbarxy,j_vorpot,j_w,j_ecin,j_convm,j_bern
     . ,vcov,ucov,h,pext,pks,pksf,vcont,ucont
     . ,phi,dv,du,dh,dp,pbaru,pbarv,Mang
     . ,pbarx,pbary,pbarxy,vorpot,w,ecin,convm,bern
     . ,z_vcov,z_ucov,z_h,z_pext,z_pks,z_pksf,z_vcont,z_ucont
     . ,z_phi,z_dv,z_du,z_dh,z_dp,z_pbaru,z_pbarv,z_Mang
     . ,z_pbarx,z_pbary,z_pbarxy,z_vorpot,z_w,z_ecin,z_convm,z_bern
     . ,fj0(i))
      print*,'FONCJ0 end',fj0

      enddo

c------------------------------------------------------------------------


      call initial0(ijp1llm,ucov)
      call initial0(ijp1llm,h)
      call initial0(ijp1llm,ucont)
      call initial0(ijp1llm,phi)
      call initial0(ijp1llm,du)
      call initial0(ijp1llm,dh)
      call initial0(ijp1llm,Mang)
      call initial0(ijp1llm,pbaru)
      call initial0(ijp1llm,w)
      call initial0(ijp1llm,ecin)
      call initial0(ijp1llm,convm)
      call initial0(ijp1llm,bern)
      call initial0(ijmllm,vcov)
      call initial0(ijmllm,vcont)
      call initial0(ijmllm,dv)
      call initial0(ijmllm,pbarv)
      call initial0(ijmllm,vorpot)
      call initial0(ip1jmp1,pext)
      call initial0(ip1jmp1,pks)
      call initial0(ip1jmp1,pksf)
      call initial0(ip1jmp1,dp)
      call initial0(ip1jmp1,pbarx)
      call initial0(ip1jm,pbary)
      call initial0(ip1jm,pbarxy)

      call initial0(ijp1llm,ucov)
      call initial0(ijp1llm,h)
      call initial0(ijp1llm,ucont)
      call initial0(ijp1llm,phi)
      call initial0(ijp1llm,du)
      call initial0(ijp1llm,dh)
      call initial0(ijp1llm,Mang)
      call initial0(ijp1llm,pbaru)
      call initial0(ijp1llm,w)
      call initial0(ijp1llm,ecin)
      call initial0(ijp1llm,convm)
      call initial0(ijp1llm,bern)
      call initial0(ijmllm,vcov)
      call initial0(ijmllm,vcont)
      call initial0(ijmllm,dv)
      call initial0(ijmllm,pbarv)
      call initial0(ijmllm,vorpot)
      call initial0(ip1jmp1,pext)
      call initial0(ip1jmp1,pks)
      call initial0(ip1jmp1,pksf)
      call initial0(ip1jmp1,dp)
      call initial0(ip1jmp1,pbarx)
      call initial0(ip1jm,pbary)
      call initial0(ip1jm,pbarxy)

      call initial0(ijp1llm,ucov_d)
      call initial0(ijp1llm,h_d)
      call initial0(ijp1llm,ucont_d)
      call initial0(ijp1llm,phi_d)
      call initial0(ijp1llm,du_d)
      call initial0(ijp1llm,dh_d)
      call initial0(ijp1llm,Mang_d)
      call initial0(ijp1llm,pbaru_d)
      call initial0(ijp1llm,w_d)
      call initial0(ijp1llm,ecin_d)
      call initial0(ijp1llm,convm_d)
      call initial0(ijp1llm,bern_d)
      call initial0(ijmllm,vcov_d)
      call initial0(ijmllm,vcont_d)
      call initial0(ijmllm,dv_d)
      call initial0(ijmllm,pbarv_d)
      call initial0(ijmllm,vorpot_d)
      call initial0(ip1jmp1,pext_d)
      call initial0(ip1jmp1,pks_d)
      call initial0(ip1jmp1,pksf_d)
      call initial0(ip1jmp1,dp_d)
      call initial0(ip1jmp1,pbarx_d)
      call initial0(ip1jm,pbary_d)
      call initial0(ip1jm,pbarxy_d)

      call initial0(ijp1llm,ucov_g)
      call initial0(ijp1llm,h_g)
      call initial0(ijp1llm,ucont_g)
      call initial0(ijp1llm,phi_g)
      call initial0(ijp1llm,du_g)
      call initial0(ijp1llm,dh_g)
      call initial0(ijp1llm,Mang_g)
      call initial0(ijp1llm,pbaru_g)
      call initial0(ijp1llm,w_g)
      call initial0(ijp1llm,ecin_g)
      call initial0(ijp1llm,convm_g)
      call initial0(ijp1llm,bern_g)
      call initial0(ijmllm,vcov_g)
      call initial0(ijmllm,vcont_g)
      call initial0(ijmllm,dv_g)
      call initial0(ijmllm,pbarv_g)
      call initial0(ijmllm,vorpot_g)
      call initial0(ip1jmp1,pext_g)
      call initial0(ip1jmp1,pks_g)
      call initial0(ip1jmp1,pksf_g)
      call initial0(ip1jmp1,dp_g)
      call initial0(ip1jmp1,pbarx_g)
      call initial0(ip1jm,pbary_g)
      call initial0(ip1jm,pbarxy_g)


c-----------------------------------------------------------------------
c   calcul du gradient de J par rapport a X

      print*,'GRADJ'
      call gradj(
     .  j_vcov,j_ucov,j_h,j_pext,j_pks,j_pksf,j_vcont,j_ucont
     . ,j_phi,j_dv,j_du,j_dh,j_dp,j_pbaru,j_pbarv,j_Mang
     . ,j_pbarx,j_pbary,j_pbarxy,j_vorpot,j_w,j_ecin,j_convm,j_bern
     . ,vcov_g,ucov_g,h_g,pext_g,pks_g,pksf_g,vcont_g,ucont_g
     . ,phi_g,dv_g,du_g,dh_g,dp_g,pbaru_g,pbarv_g,Mang_g
     . ,pbarx_g,pbary_g,pbarxy_g,vorpot_g,w_g,ecin_g,convm_g,bern_g
     . ,z_vcov,z_ucov,z_h,z_pext,z_pks,z_pksf,z_vcont,z_ucont
     . ,z_phi,z_dv,z_du,z_dh,z_dp,z_pbaru,z_pbarv,z_Mang
     . ,z_pbarx,z_pbary,z_pbarxy,z_vorpot,z_w,z_ecin,z_convm,z_bern
     . )
      print*,'GRADJ end'

#include "adj.adjoint.h"

c   chois de la direction de test
c   Ici on garde la direction du gradient

      print*,'CALCUL ADJOINT end'
CHOIX de dX:
c   1er cas, on prend directement le gradient.
      call scopy(ijp1llm,ucov_g,1,ucov_d,1)
      call scopy(ijp1llm,h_g,1,h_d,1)
      call scopy(ijp1llm,ucont_g,1,ucont_d,1)
      call scopy(ijp1llm,phi_g,1,phi_d,1)
      call scopy(ijp1llm,du_g,1,du_d,1)
      call scopy(ijp1llm,dh_g,1,dh_d,1)
      call scopy(ijp1llm,Mang_g,1,Mang_d,1)
      call scopy(ijp1llm,pbaru_g,1,pbaru_d,1)
      call scopy(ijp1llm,w_g,1,w_d,1)
      call scopy(ijp1llm,ecin_g,1,ecin_d,1)
      call scopy(ijp1llm,convm_g,1,convm_d,1)
      call scopy(ijp1llm,bern_g,1,bern_d,1)
      call scopy(ijmllm,vcov_g,1,vcov_d,1)
      call scopy(ijmllm,vcont_g,1,vcont_d,1)
      call scopy(ijmllm,dv_g,1,dv_d,1)
      call scopy(ijmllm,pbarv_g,1,pbarv_d,1)
      call scopy(ijmllm,vorpot_g,1,vorpot_d,1)
      call scopy(ip1jmp1,pext_g,1,pext_d,1)
      call scopy(ip1jmp1,pks_g,1,pks_d,1)
      call scopy(ip1jmp1,pksf_g,1,pksf_d,1)
      call scopy(ip1jmp1,dp_g,1,dp_d,1)
      call scopy(ip1jmp1,pbarx_g,1,pbarx_d,1)
      call scopy(ip1jm,pbary_g,1,pbary_d,1)
      call scopy(ip1jm,pbarxy_g,1,pbarxy_d,1)

      print*,'Fin premier cas'
c
c   2eme cas, om prend une perturbation quelconque ran1*X
      do l=1,llm
         do ij=1,ip1jmp1
            ucov_d(ij,l)=i_ucov*ucov_0(ij,l)*ran1(idum)
            h_d(ij,l)=i_h*h_0(ij,l)*ran1(idum)
            ucont_d(ij,l)=i_ucont*ucont_0(ij,l)*ran1(idum)
            phi_d(ij,l)=i_phi*phi_0(ij,l)*ran1(idum)
            du_d(ij,l)=i_du*du_0(ij,l)*ran1(idum)
            dh_d(ij,l)=i_dh*dh_0(ij,l)*ran1(idum)
            Mang_d(ij,l)=i_Mang*Mang_0(ij,l)*ran1(idum)
            pbaru_d(ij,l)=i_pbaru*pbaru_0(ij,l)*ran1(idum)
            w_d(ij,l)=i_w*w_0(ij,l)*ran1(idum)
            ecin_d(ij,l)=i_ecin*ecin_0(ij,l)*ran1(idum)
            convm_d(ij,l)=i_convm*convm_0(ij,l)*ran1(idum)
            bern_d(ij,l)=i_bern*bern_0(ij,l)*ran1(idum)
         enddo
         do ij=1,ip1jm
            vcov_d(ij,l)=i_vcov*vcov_0(ij,l)*ran1(idum)
            vcont_d(ij,l)=i_vcont*vcont_0(ij,l)*ran1(idum)
            dv_d(ij,l)=i_dv*dv_0(ij,l)*ran1(idum)
            pbarv_d(ij,l)=i_pbarv*pbarv_0(ij,l)*ran1(idum)
            vorpot_d(ij,l)=i_vorpot*vorpot_0(ij,l)*ran1(idum)
         enddo
      enddo
      do ij=1,ip1jmp1
         pext_d(ij)=i_pext*pext_0(ij)*ran1(idum)
         pks_d(ij)=i_pks*pks_0(ij)*ran1(idum)
         pksf_d(ij)=i_pksf*pksf_0(ij)*ran1(idum)
         dp_d(ij)=i_dp*dp_0(ij)*ran1(idum)
         pbarx_d(ij)=i_pbarx*pbarx_0(ij)*ran1(idum)
      enddo
      do ij=1,ip1jm
         pbary_d(ij)=i_pbary*pbary_0(ij)*ran1(idum)
         pbarxy_d(ij)=i_pbarxy*pbarxy_0(ij)*ran1(idum)
      enddo

      print*,'Fin initialisation dX'

c-----------------------------------------------------------------------
c   calcul de :
c   ------------------
      djdx=0.
      do l=1,llm
         do ij=1,ip1jmp1
            djdx=djdx+i_ucov*ucov_g(ij,l)*ucov_d(ij,l)
            djdx=djdx+i_h*h_g(ij,l)*h_d(ij,l)
            djdx=djdx+i_ucont*ucont_g(ij,l)*ucont_d(ij,l)
            djdx=djdx+i_phi*phi_g(ij,l)*phi_d(ij,l)
            djdx=djdx+i_du*du_g(ij,l)*du_d(ij,l)
            djdx=djdx+i_dh*dh_g(ij,l)*dh_d(ij,l)
            djdx=djdx+i_Mang*Mang_g(ij,l)*Mang_d(ij,l)
            djdx=djdx+i_pbaru*pbaru_g(ij,l)*pbaru_d(ij,l)
            djdx=djdx+i_w*w_g(ij,l)*w_d(ij,l)
            djdx=djdx+i_ecin*ecin_g(ij,l)*ecin_d(ij,l)
            djdx=djdx+i_convm*convm_g(ij,l)*convm_d(ij,l)
            djdx=djdx+i_bern*bern_g(ij,l)*bern_d(ij,l)
         enddo
         do ij=1,ip1jm
            djdx=djdx+i_vcov*vcov_g(ij,l)*vcov_d(ij,l)
            djdx=djdx+i_vcont*vcont_g(ij,l)*vcont_d(ij,l)
            djdx=djdx+i_dv*dv_g(ij,l)*dv_d(ij,l)
            djdx=djdx+i_pbarv*pbarv_g(ij,l)*pbarv_d(ij,l)
            djdx=djdx+i_vorpot*vorpot_g(ij,l)*vorpot_d(ij,l)
         enddo
      enddo
      do ij=1,ip1jmp1
         djdx=djdx+i_pext*pext_g(ij)*pext_d(ij)
         djdx=djdx+i_pks*pks_g(ij)*pks_d(ij)
         djdx=djdx+i_pksf*pksf_g(ij)*pksf_d(ij)
         djdx=djdx+i_dp*dp_g(ij)*dp_d(ij)
         djdx=djdx+i_pbarx*pbarx_g(ij)*pbarx_d(ij)
      enddo
      do ij=1,ip1jm
         djdx=djdx+i_pbary*pbary_g(ij)*pbary_d(ij)
         djdx=djdx+i_pbarxy*pbarxy_g(ij)*pbarxy_d(ij)
      enddo

      print*,'Fin du calcul de '

c-----------------------------------------------------------------------
c   quelques impressions:
c   ---------------------
      print*,'OK1'
      write(67,*) '================='
      write(67,*) 'TEST ADJOINT DE'
#include "adj.print.h"
      write(67,*) '================='
      write(67,*)
      write(67,*) 'Valeur de reference de J: J(X)='
      write(67,'(2e25.16)') fj0
      write(67,*)
      write(67,*) 'Valeur du gradient de J: ='
      write(67,'(e50.16)') djdx
      write(67,*)
      write(67,*) 'J(X+adX)-J(X)'
      write(67,'(a9,a8,3a23)')
     .' -         ','    a   ','  J(X+adX)    '
     .      ,' J(X+adX)-J(X)   ','   a    '
c     write(67,'(6a13)')
c    .' -         ','     a      ','  J(X+adX)  ','   J(X) '
c    .      ,' J(X+adX)-J(X) ','   a'
      write(67,*) 'a'
      print*,'OK2'

c-----------------------------------------------------------------------
c   debut de la boucle sur les valeurs de alpha:
c   --------------------------------------------
c     zz=1.e50
      izz=50
      do ialpha=1,80
      print*,'ialpha=',ialpha
c        zz=zz/10.
         izz=izz-1
         zz=10.**izz
         print*,'ZZ',zz

c   calcul de M(X+a*dX)
c-----------------------------------------------------------------------
c   calcul de X=X0+a*dX:
c   --------------------

      do l=1,llm
         do ij=1,ip1jmp1
            ucov(ij,l)=ucov_0(ij,l)+zz*i_ucov*ucov_d(ij,l)
            h(ij,l)=h_0(ij,l)+zz*i_h*h_d(ij,l)
            ucont(ij,l)=ucont_0(ij,l)+zz*i_ucont*ucont_d(ij,l)
            phi(ij,l)=phi_0(ij,l)+zz*i_phi*phi_d(ij,l)
            du(ij,l)=du_0(ij,l)+zz*i_du*du_d(ij,l)
            dh(ij,l)=dh_0(ij,l)+zz*i_dh*dh_d(ij,l)
            Mang(ij,l)=Mang_0(ij,l)+zz*i_Mang*Mang_d(ij,l)
            pbaru(ij,l)=pbaru_0(ij,l)+zz*i_pbaru*pbaru_d(ij,l)
            w(ij,l)=w_0(ij,l)+zz*i_w*w_d(ij,l)
            ecin(ij,l)=ecin_0(ij,l)+zz*i_ecin*ecin_d(ij,l)
            convm(ij,l)=convm_0(ij,l)+zz*i_convm*convm_d(ij,l)
            bern(ij,l)=bern_0(ij,l)+zz*i_bern*bern_d(ij,l)
         enddo
         do ij=1,ip1jm
            vcov(ij,l)=vcov_0(ij,l)+zz*i_vcov*vcov_d(ij,l)
            vcont(ij,l)=vcont_0(ij,l)+zz*i_vcont*vcont_d(ij,l)
            dv(ij,l)=dv_0(ij,l)+zz*i_dv*dv_d(ij,l)
            pbarv(ij,l)=pbarv_0(ij,l)+zz*i_pbarv*pbarv_d(ij,l)
            vorpot(ij,l)=vorpot_0(ij,l)+zz*i_vorpot*vorpot_d(ij,l)
         enddo
      enddo
      do ij=1,ip1jmp1
         pext(ij)=pext_0(ij)+zz*i_pext*pext_d(ij)
         pks(ij)=pks_0(ij)+zz*i_pks*pks_d(ij)
         pksf(ij)=pksf_0(ij)+zz*i_pksf*pksf_d(ij)
         dp(ij)=dp_0(ij)+zz*i_dp*dp_d(ij)
         pbarx(ij)=pbarx_0(ij)+zz*i_pbarx*pbarx_d(ij)
      enddo
      do ij=1,ip1jm
         pbary(ij)=pbary_0(ij)+zz*i_pbary*pbary_d(ij)
         pbarxy(ij)=pbarxy_0(ij)+zz*i_pbarxy*pbarxy_d(ij)
      enddo


c-----------------------------------------------------------------------
c   calcul de M(X):
c   ---------------

#include "adj.direct.h"

c-----------------------------------------------------------------------
c   calcul de J(X):
c   ---------------

c   calcul de J[M(X+a*dX)]
      call foncj(
     .  j_vcov,j_ucov,j_h,j_pext,j_pks,j_pksf,j_vcont,j_ucont
     . ,j_phi,j_dv,j_du,j_dh,j_dp,j_pbaru,j_pbarv,j_Mang
     . ,j_pbarx,j_pbary,j_pbarxy,j_vorpot,j_w,j_ecin,j_convm,j_bern
     . ,vcov,ucov,h,pext,pks,pksf,vcont,ucont
     . ,phi,dv,du,dh,dp,pbaru,pbarv,Mang
     . ,pbarx,pbary,pbarxy,vorpot,w,ecin,convm,bern
     . ,z_vcov,z_ucov,z_h,z_pext,z_pks,z_pksf,z_vcont,z_ucont
     . ,z_phi,z_dv,z_du,z_dh,z_dp,z_pbaru,z_pbarv,z_Mang
     . ,z_pbarx,z_pbary,z_pbarxy,z_vorpot,z_w,z_ecin,z_convm,z_bern
     . ,fj)

         resi=(fj-fj0(1))-zz*djdx
         write(67,'(e9.3,e8.1,3e23.16,x,3i1)')
     .   resi,zz,fj,fj-fj0(1),zz*djdx
     .   ,nint(abs(resi/(fj0(1)*eps)))
     .   ,nint(abs(resi/(fj*eps)))
     .   ,nint(abs(resi/(zz*djdx*eps)))
c    .   ,abs(fj-fj0(1)).gt.eps*AMAX1(abs(fj0(1)),abs(fj)),
c    .   abs(fj-fj0(1)-zz*djdx).gt.
c    .   10.*eps*AMAX1(abs(fj-fj0(1)),abs(zz*djdx))
      enddo
      write(67,*)
      write(67,*)
      write(67,*) 'Fichier de definition du test:'
      end
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC *=*=*=*= foncj.html =*=*=*=*
subroutine foncj

subroutine foncj


      subroutine foncj(
     .  j_vcov,j_ucov,j_h,j_pext,j_pks,j_pksf,j_vcont,j_ucont
     . ,j_phi,j_dv,j_du,j_dh,j_dp,j_pbaru,j_pbarv,j_Mang
     . ,j_pbarx,j_pbary,j_pbarxy,j_vorpot,j_w,j_ecin,j_convm,j_bern
     . ,vcov,ucov,h,pext,pks,pksf,vcont,ucont
     . ,phi,dv,du,dh,dp,pbaru,pbarv,Mang
     . ,pbarx,pbary,pbarxy,vorpot,w,ecin,convm,bern
     . ,z_vcov,z_ucov,z_h,z_pext,z_pks,z_pksf,z_vcont,z_ucont
     . ,z_phi,z_dv,z_du,z_dh,z_dp,z_pbaru,z_pbarv,z_Mang
     . ,z_pbarx,z_pbary,z_pbarxy,z_vorpot,z_w,z_ecin,z_convm,z_bern
     . ,fj)

      implicit none

#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"
#include "comvert.h"
#include "comgeom.h"

      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),h(ip1jmp1,llm)
      REAL pext(ip1jmp1),pks(ip1jmp1),pksf(ip1jmp1)
      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
      REAL phi(ip1jmp1,llm)
      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
      REAL Mang(ip1jmp1,llm)
      REAL pbarx(ip1jmp1),pbary(ip1jm),pbarxy(ip1jm)
      REAL vorpot(ip1jm,llm)
      REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
      REAL bern(ip1jmp1,llm)

      REAL z_vcov(ip1jm,llm),z_ucov(ip1jmp1,llm),z_h(ip1jmp1,llm)
      REAL z_pext(ip1jmp1),z_pks(ip1jmp1)
      REAL z_pksf(ip1jmp1)
      REAL z_vcont(ip1jm,llm),z_ucont(ip1jmp1,llm)
      REAL z_phi(ip1jmp1,llm)
      REAL z_dv(ip1jm,llm),z_du(ip1jmp1,llm)
      REAL z_dh(ip1jmp1,llm),z_dp(ip1jmp1)
      REAL z_pbaru(ip1jmp1,llm),z_pbarv(ip1jm,llm)
      REAL z_Mang(ip1jmp1,llm)
      REAL z_pbarx(ip1jmp1),z_pbary(ip1jm),z_pbarxy(ip1jm)
      REAL z_vorpot(ip1jm,llm)
      REAL z_w(ip1jmp1,llm),z_ecin(ip1jmp1,llm),z_convm(ip1jmp1,llm)
      REAL z_bern(ip1jmp1,llm)

      INTEGER j_vcov,j_ucov,j_h
      INTEGER j_pext,j_pks
      INTEGER j_pksf
      INTEGER j_vcont,j_ucont
      INTEGER j_phi
      INTEGER j_dv,j_du
      INTEGER j_dh,j_dp
      INTEGER j_pbaru,j_pbarv
      INTEGER j_Mang
      INTEGER j_pbarx,j_pbary,j_pbarxy
      INTEGER j_vorpot
      INTEGER j_w,j_ecin,j_convm
      INTEGER j_bern

      INTEGER ij,l
      REAL fj
c
      fj=0.
      do l=1,llm
         do ij=1,ip1jmp1
            fj=fj+j_ucov*ucov(ij,l)*z_ucov(ij,l)
            fj=fj+j_h*h(ij,l)*z_h(ij,l)
            fj=fj+j_ucont*ucont(ij,l)*z_ucont(ij,l)
            fj=fj+j_phi*phi(ij,l)*z_phi(ij,l)
            fj=fj+j_du*du(ij,l)*z_du(ij,l)
            fj=fj+j_dh*dh(ij,l)*z_dh(ij,l)
            fj=fj+j_Mang*Mang(ij,l)*z_Mang(ij,l)
            fj=fj+j_pbaru*pbaru(ij,l)*z_pbaru(ij,l)
            fj=fj+j_w*w(ij,l)*z_w(ij,l)
            fj=fj+j_ecin*ecin(ij,l)*z_ecin(ij,l)
            fj=fj+j_convm*convm(ij,l)*z_convm(ij,l)
            fj=fj+j_bern*bern(ij,l)*z_bern(ij,l)
         enddo
         do ij=1,ip1jm
            fj=fj+j_vcov*vcov(ij,l)*z_vcov(ij,l)
            fj=fj+j_vcont*vcont(ij,l)*z_vcont(ij,l)
            fj=fj+j_dv*dv(ij,l)*z_dv(ij,l)
            fj=fj+j_pbarv*pbarv(ij,l)*z_pbarv(ij,l)
            fj=fj+j_vorpot*vorpot(ij,l)*z_vorpot(ij,l)
         enddo
      enddo
      print*,'OK1'
      do ij=1,ip1jmp1
         fj=fj+j_pext*pext(ij)*z_pext(ij)
         fj=fj+j_pks*pks(ij)*z_pks(ij)
         fj=fj+j_pksf*pksf(ij)*z_pksf(ij)
         fj=fj+j_dp*dp(ij)*z_dp(ij)
         fj=fj+j_pbarx*pbarx(ij)*z_pbarx(ij)
      enddo
         print*,'fj.1=',fj
      print*,'OK2'
      do ij=1,ip1jm
         fj=fj+j_pbary*pbary(ij)*z_pbary(ij)
         fj=fj+j_pbarxy*pbarxy(ij)*z_pbarxy(ij)
      enddo
         print*,'fj.2=',fj

      print*,'OK3'
      return
      end
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC *=*=*=*= gradj.html =*=*=*=*
subroutine gradj

subroutine gradj


      subroutine gradj(
     .  j_vcov,j_ucov,j_h,j_pext,j_pks,j_pksf,j_vcont,j_ucont
     . ,j_phi,j_dv,j_du,j_dh,j_dp,j_pbaru,j_pbarv,j_Mang
     . ,j_pbarx,j_pbary,j_pbarxy,j_vorpot,j_w,j_ecin,j_convm,j_bern
     . ,vcov,ucov,h,pext,pks,pksf,vcont,ucont
     . ,phi,dv,du,dh,dp,pbaru,pbarv,Mang
     . ,pbarx,pbary,pbarxy,vorpot,w,ecin,convm,bern
     . ,z_vcov,z_ucov,z_h,z_pext,z_pks,z_pksf,z_vcont,z_ucont
     . ,z_phi,z_dv,z_du,z_dh,z_dp,z_pbaru,z_pbarv,z_Mang
     . ,z_pbarx,z_pbary,z_pbarxy,z_vorpot,z_w,z_ecin,z_convm,z_bern
     .  )

      implicit none

#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"
#include "comvert.h"
#include "comgeom.h"

      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),h(ip1jmp1,llm)
      REAL pext(ip1jmp1),pks(ip1jmp1),pksf(ip1jmp1)
      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
      REAL phi(ip1jmp1,llm)
      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
      REAL Mang(ip1jmp1,llm)
      REAL pbarx(ip1jmp1),pbary(ip1jm),pbarxy(ip1jm)
      REAL vorpot(ip1jm,llm)
      REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
      REAL bern(ip1jmp1,llm)

      REAL z_vcov(ip1jm,llm),z_ucov(ip1jmp1,llm),z_h(ip1jmp1,llm)
      REAL z_pext(ip1jmp1),z_pks(ip1jmp1)
      REAL z_pksf(ip1jmp1)
      REAL z_vcont(ip1jm,llm),z_ucont(ip1jmp1,llm)
      REAL z_phi(ip1jmp1,llm)
      REAL z_dv(ip1jm,llm),z_du(ip1jmp1,llm)
      REAL z_dh(ip1jmp1,llm),z_dp(ip1jmp1)
      REAL z_pbaru(ip1jmp1,llm),z_pbarv(ip1jm,llm)
      REAL z_Mang(ip1jmp1,llm)
      REAL z_pbarx(ip1jmp1),z_pbary(ip1jm),z_pbarxy(ip1jm)
      REAL z_vorpot(ip1jm,llm)
      REAL z_w(ip1jmp1,llm),z_ecin(ip1jmp1,llm),z_convm(ip1jmp1,llm)
      REAL z_bern(ip1jmp1,llm)

      INTEGER j_vcov,j_ucov,j_h
      INTEGER j_pext,j_pks
      INTEGER j_pksf
      INTEGER j_vcont,j_ucont
      INTEGER j_phi
      INTEGER j_dv,j_du
      INTEGER j_dh,j_dp
      INTEGER j_pbaru,j_pbarv
      INTEGER j_Mang
      INTEGER j_pbarx,j_pbary,j_pbarxy
      INTEGER j_vorpot
      INTEGER j_w,j_ecin,j_convm
      INTEGER j_bern

      INTEGER ij,l
c
      do l=1,llm
         do ij=1,ip1jmp1
            ucov(ij,l)=j_ucov*z_ucov(ij,l)
            h(ij,l)=j_h*z_h(ij,l)
            ucont(ij,l)=j_ucont*z_ucont(ij,l)
            phi(ij,l)=j_phi*z_phi(ij,l)
            du(ij,l)=j_du*z_du(ij,l)
            dh(ij,l)=j_dh*z_dh(ij,l)
            Mang(ij,l)=j_Mang*z_Mang(ij,l)
            pbaru(ij,l)=j_pbaru*z_pbaru(ij,l)
            w(ij,l)=j_w*z_w(ij,l)
            ecin(ij,l)=j_ecin*z_ecin(ij,l)
            convm(ij,l)=j_convm*z_convm(ij,l)
            bern(ij,l)=j_bern*z_bern(ij,l)
         enddo
         do ij=1,ip1jm
            vcov(ij,l)=j_vcov*z_vcov(ij,l)
            vcont(ij,l)=j_vcont*z_vcont(ij,l)
            dv(ij,l)=j_dv*z_dv(ij,l)
            pbarv(ij,l)=j_pbarv*z_pbarv(ij,l)
            vorpot(ij,l)=j_vorpot*z_vorpot(ij,l)
         enddo
      enddo
      do ij=1,ip1jmp1
         pext(ij)=j_pext*z_pext(ij)
         pks(ij)=j_pks*z_pks(ij)
         pksf(ij)=j_pksf*z_pksf(ij)
         dp(ij)=j_dp*z_dp(ij)
         pbarx(ij)=j_pbarx*z_pbarx(ij)
      enddo
      do ij=1,ip1jm
         pbary(ij)=j_pbary*z_pbary(ij)
         pbarxy(ij)=j_pbarxy*z_pbarxy(ij)
      enddo

      return
      end
c---------------------------------------------------------------------- *=*=*=*= initestadj.html =*=*=*=*
subroutine initestadj

subroutine initestadj


      subroutine initestadj(phis,
     .  vcov,ucov,h,pext,pks,pksf,vcont,ucont
     . ,phi,dv,du,dh,dp,pbaru,pbarv,Mang
     . ,pbarx,pbary,pbarxy,vorpot,w,ecin,convm,bern
     . ,z_vcov,z_ucov,z_h,z_pext,z_pks,z_pksf,z_vcont,z_ucont
     . ,z_phi,z_dv,z_du,z_dh,z_dp,z_pbaru,z_pbarv,z_Mang
     . ,z_pbarx,z_pbary,z_pbarxy,z_vorpot,z_w,z_ecin,z_convm,z_bern
     . ,ieps,zeps)
      implicit none

#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"
#include "comvert.h"
#include "comgeom.h"

      INTEGER ij,l,ieps,idum
      REAL zeps
      REAL phis(ip1jmp1),ran1,xx

c facteurs de normalisation pour la fonction J
      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),h(ip1jmp1,llm)
      REAL pext(ip1jmp1),pks(ip1jmp1)
      REAL pksf(ip1jmp1)
      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
      REAL phi(ip1jmp1,llm)
      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
      REAL Mang(ip1jmp1,llm)
      REAL pbarx(ip1jmp1),pbary(ip1jm),pbarxy(ip1jm)
      REAL vorpot(ip1jm,llm)
      REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
      REAL bern(ip1jmp1,llm)
c facteurs de normalisation pour la fonction J
      REAL z_vcov(ip1jm,llm),z_ucov(ip1jmp1,llm),z_h(ip1jmp1,llm)
      REAL z_pext(ip1jmp1),z_pks(ip1jmp1)
      REAL z_pksf(ip1jmp1)
      REAL z_vcont(ip1jm,llm),z_ucont(ip1jmp1,llm)
      REAL z_phi(ip1jmp1,llm)
      REAL z_dv(ip1jm,llm),z_du(ip1jmp1,llm)
      REAL z_dh(ip1jmp1,llm),z_dp(ip1jmp1)
      REAL z_pbaru(ip1jmp1,llm),z_pbarv(ip1jm,llm)
      REAL z_Mang(ip1jmp1,llm)
      REAL z_pbarx(ip1jmp1),z_pbary(ip1jm),z_pbarxy(ip1jm)
      REAL z_vorpot(ip1jm,llm)
      REAL z_w(ip1jmp1,llm),z_ecin(ip1jmp1,llm),z_convm(ip1jmp1,llm)
      REAL z_bern(ip1jmp1,llm)

      logical first
      save first

      data first/.true./

      idum=-1
      xx=ran1(idum)
      idum=0

      do l=1,llm
         do ij=1,ip1jmp1
            ucov(ij,l)=cu(ij)*10.
            h(ij,l)=200.
c    .      *(1.+.2*cos(rlatu((ij-1)/iip1+1)))
     .      *cpp/(s(cppp/(s(l)*1000.**kappa)
         enddo
         do ij=iip2,ip1jm
            ucov(ij,l)=ucov(ij,l)*(1.+.1*ran1(idum))
            h(ij,l)=h(ij,l)*(1.+.1*ran1(idum))
         enddo
         do ij=1,ip1jm
            vcov(ij,l)=cv(ij)*(10.+ran1(idum))
         enddo
      enddo
      do ij=1,iip1
         phis(ij)=0.
         pext(ij)=aire(ij)*1000.
         phis(ij+ip1jm)=0.
         pext(ij+ip1jm)=aire(ij+ip1jm)*1000.
      enddo
      do ij=iip2,ip1jm
         phis(ij)=0.
         pext(ij)=100.*(10.+ran1(idum))*aire(ij)
      enddo

      call scopy(jjp1*llm,ucov,iip1,ucov(iip1,1),iip1)
      call scopy(jjm*llm,vcov,iip1,vcov(iip1,1),iip1)
      call scopy(jjp1*llm,h,iip1,h(iip1,1),iip1)
      call scopy(jjp1,pext(1),iip1,pext(iip1),iip1)

      if(ieps.eq.1) then
      call multscal(ijp1llm,ucov,zeps,ucov)
      call multscal(ijp1llm,h,zeps,h)
      call multscal(ijmllm,vcov,zeps,vcov)
      call multscal(ip1jmp1,pext,zeps,pext)
      endif

      CALL exner(ip1jmp1,pext,aire,pks,pksf)
      print*,'IP1JMP1 ',ip1jmp1
      print*,'PEXT',pext
      print*,'AIRE',aire
      print*,'PKS',pks
      print*,'PKSf',pksf
      print*,'PHIS',phis
      print*,'DS',ds,llm
      CALL geopot  (ip1jmp1, h, pks, phis, phi)
      CALL covcont (llm,ucov,vcov,ucont,vcont)
      do l=1,llm
      do ij=1,ip1jmp1
         ucont(ij,l)=0.
         ucont(ij+ip1jm,l)=0.
         du(ij,l)=0.
         du(ij+ip1jm,l)=0.
      enddo
      enddo
      CALL pbar    ( pext ,pbarx , pbary, pbarxy              )
      CALL flumass ( pbarx,pbary,vcont,ucont,pbaru,pbarv)
      CALL dh1 ( h, pbaru, pbarv, dh)
      CALL convmas ( pbaru, pbarv, convm                      )
      DO ij = 1, ip1jmp1
         dp( ij ) = convm( ij,1 )
      ENDDO
      print*,'OK convmas'
      CALL vitvert ( convm , w                             )
      CALL tourpot ( vcov  , ucov  , pbarxy  , vorpot       )
      CALL dudv1   ( vorpot, pbaru , pbarv   , du    , dv   )
      CALL enercin ( vcov  , ucov  , vcont   , ucont , ecin )
      CALL bernoui ( ip1jmp1,llm,phi   , ecin  , bern       )
      CALL dudv2   ( h     , pksf  , bern    , du    , dv   )
      DO l=1,llm
         DO ij=1,ip1jmp1
            Mang(ij,l)=ucov(ij,l)+constang(ij)
         ENDDO
      ENDDO
      CALL advect(Mang,vcov,h,w,pbarx,pbary,du,dv,dh)

c calcul des coefficients z_X
      if (first) then
      first=.false.
      if (1 .eq.1 ) then
      do l=1,llm
         do ij=1,ip1jmp1
            z_ucov(ij,l)=sqrt(unscu2(ij))/10.
            z_h(ij,l)=1000.**kappa/(300.*cpp)
            z_ucont(ij,l)=cu(ij)/10.
            z_phi(ij,l)=1./(r*300.)
            z_du(ij,l)=sqrt(unscu2(ij))/(2*omeg*0.5*10.)
            z_dh(ij,l)=1000.**kappa/(300.*cpp)/(2*omeg*0.5)
            z_Mang(ij,l)=sqrt(unscu2(ij))/(rad*omeg*0.5)
            z_pbaru(ij,l)=cu(ij)/(10.*1000.*aireu(ij))
            z_w(ij,l)=1.
            z_ecin(ij,l)=1./(10.*10.)
            z_convm(ij,l)=1.
            z_bern(ij,l)=1./(r*300.)
         enddo
         do ij=1,ip1jm
            z_vcov(ij,l)=sqrt(unscv2(ij))/10.
            z_vcont(ij,l)=cv(ij)/10.
            z_dv(ij,l)=sqrt(unscv2(ij))/(2.*omeg*0.5*10.)
            z_pbarv(ij,l)=cv(ij)/(airev(ij)*1000.*10.)
            z_vorpot(ij,l)=1000./fext(ip1jmp1/4)/unsairez(ij)
         enddo
      enddo
      do ij=1,ip1jmp1
         z_pext(ij)=1./(1000.*aire(ij))
         z_pks(ij)=1./(1000.**kappa)
         z_pksf(ij)=1./(1000.**kappa)
         z_dp(ij)=1.
         z_pbarx(ij)=1./(1000.*aireu(ij))
      enddo
      do ij=1,ip1jm
         z_pbary(ij)=1./(1000.*airev(ij))
         z_pbarxy(ij)=1./1000.*unsairez(ij)
      enddo

c   peturbation aleatoire sur els coeffs de la fonction cout
      do l=1,llm
         do ij=iip2,ip1jm
            z_ucov(ij,l)=z_ucov(ij,l)*ran1(idum)
            z_h(ij,l)=z_h(ij,l)*ran1(idum)
            z_ucont(ij,l)=z_ucont(ij,l)*ran1(idum)
            z_phi(ij,l)=z_phi(ij,l)*ran1(idum)
            z_du(ij,l)=z_du(ij,l)*ran1(idum)
            z_dh(ij,l)=z_dh(ij,l)*ran1(idum)
            z_Mang(ij,l)=z_Mang(ij,l)*ran1(idum)
            z_pbaru(ij,l)=z_pbaru(ij,l)*ran1(idum)
            z_w(ij,l)=z_w(ij,l)*ran1(idum)
            z_ecin(ij,l)=z_ecin(ij,l)*ran1(idum)
            z_convm(ij,l)=z_convm(ij,l)*ran1(idum)
            z_bern(ij,l)=z_bern(ij,l)*ran1(idum)
         enddo
         do ij=1,ip1jm
            z_vcov(ij,l)=z_vcov(ij,l)*ran1(idum)
            z_vcont(ij,l)=z_vcont(ij,l)*ran1(idum)
            z_dv(ij,l)=z_dv(ij,l)*ran1(idum)
            z_pbarv(ij,l)=z_pbarv(ij,l)*ran1(idum)
            z_vorpot(ij,l)=z_vorpot(ij,l)*ran1(idum)
         enddo
      enddo
      do ij=iip2,ip1jm
         z_pext(ij)=z_pext(ij)*ran1(idum)
         z_pks(ij)=z_pks(ij)*ran1(idum)
         z_pksf(ij)=z_pksf(ij)*ran1(idum)
         z_dp(ij)=z_dp(ij)*ran1(idum)
         z_pbarx(ij)=z_pbarx(ij)*ran1(idum)
      enddo
      do ij=1,ip1jm
         z_pbary(ij)=z_pbary(ij)*ran1(idum)
         z_pbarxy(ij)=z_pbarxy(ij)*ran1(idum)
      enddo

c   periodicite de la fonction cout
      call scopy(jjp1*llm,z_ucov,iip1,z_ucov(iip1,1),iip1)
      call scopy(jjp1*llm,z_h,iip1,z_h(iip1,1),iip1)
      call scopy(jjp1*llm,z_ucont,iip1,z_ucont(iip1,1),iip1)
      call scopy(jjp1*llm,z_phi,iip1,z_phi(iip1,1),iip1)
      call scopy(jjp1*llm,z_du,iip1,z_du(iip1,1),iip1)
      call scopy(jjp1*llm,z_dh,iip1,z_dh(iip1,1),iip1)
      call scopy(jjp1*llm,z_Mang,iip1,z_Mang(iip1,1),iip1)
      call scopy(jjp1*llm,z_pbaru,iip1,z_pbaru(iip1,1),iip1)
      call scopy(jjp1*llm,z_w,iip1,z_w(iip1,1),iip1)
      call scopy(jjp1*llm,z_ecin,iip1,z_ecin(iip1,1),iip1)
      call scopy(jjp1*llm,z_convm,iip1,z_convm(iip1,1),iip1)
      call scopy(jjp1*llm,z_bern,iip1,z_bern(iip1,1),iip1)
      call scopy(jjm*llm,z_vcov,iip1,z_vcov(iip1,1),iip1)
      call scopy(jjm*llm,z_vcont,iip1,z_vcont(iip1,1),iip1)
      call scopy(jjm*llm,z_dv,iip1,z_dv(iip1,1),iip1)
      call scopy(jjm*llm,z_pbarv,iip1,z_pbarv(iip1,1),iip1)
      call scopy(jjm*llm,z_vorpot,iip1,z_vorpot(iip1,1),iip1)
      call scopy(jjp1,z_pext,iip1,z_pext(iip1),iip1)
      call scopy(jjp1,z_pks,iip1,z_pks(iip1),iip1)
      call scopy(jjp1,z_pksf,iip1,z_pksf(iip1),iip1)
      call scopy(jjp1,z_dp,iip1,z_dp(iip1),iip1)
      call scopy(jjp1,z_pbarx,iip1,z_pbarx(iip1),iip1)
      call scopy(jjm,z_pbary,iip1,z_pbary(iip1),iip1)
      call scopy(jjm,z_pbarxy,iip1,z_pbarxy(iip1),iip1)

      else

      do l=1,llm
         do ij=1,ip1jmp1
            z_ucov(ij,l)=1.
            z_h(ij,l)=1.
            z_ucont(ij,l)=1.
            z_phi(ij,l)=1.
            z_du(ij,l)=1.
            z_dh(ij,l)=1.
            z_Mang(ij,l)=1.
            z_pbaru(ij,l)=1.
            z_w(ij,l)=1.
            z_ecin(ij,l)=1.
            z_convm(ij,l)=1.
            z_bern(ij,l)=1.
         enddo
         do ij=1,ip1jm
            z_vcov(ij,l)=1.
            z_vcont(ij,l)=1.
            z_dv(ij,l)=1.
            z_pbarv(ij,l)=1.
            z_vorpot(ij,l)=1.
         enddo
      enddo
      do ij=1,ip1jmp1
         z_pext(ij)=1.
         z_pks(ij)=1.
         z_pksf(ij)=1.
         z_dp(ij)=1.
         z_pbarx(ij)=1.
      enddo
      do ij=1,ip1jm
         z_pbary(ij)=1.
         z_pbarxy(ij)=1.
      enddo

      endif

      endif
c   fin du calcul des coefficients z_X

      return
      end