*=*=*=*= testadjnt.html =*=*=*=*
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 deCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC *=*=*=*= foncj.html =*=*=*=*: 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
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 endCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC *=*=*=*= gradj.html =*=*=*=*
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 endc---------------------------------------------------------------------- *=*=*=*= initestadj.html =*=*=*=*
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