! ! $Header$ ! c c #undef DEBUG_IO !#define DEBUG_IO SUBROUTINE caldyn_loc $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis , $ phi,conser,du,dv,dteta,dp,w,pbaru,pbarv,time ) USE parallel_lmdz USE Write_Field_loc USE caldyn_mod IMPLICIT NONE c======================================================================= c c Auteur : P. Le Van c c Objet: c ------ c c Calcul des tendances dynamiques. c c Modif 04/93 F.Forget c======================================================================= c----------------------------------------------------------------------- c 0. Declarations: c ---------------- #include "dimensions.h" #include "paramet.h" #include "comconst.h" #include "comvert.h" #include "comgeom.h" c Arguments: c ---------- LOGICAL conser INTEGER itau REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm) REAL teta(ijb_u:ije_u,llm) REAL ps(ijb_u:ije_u),phis(ijb_u:ije_u) REAL pk(iip1,jjb_u:jje_u,llm),pkf(ijb_u:ije_u,llm) REAL phi(ijb_u:ije_u,llm),masse(ijb_u:ije_u,llm) REAL dv(ijb_v:ije_v,llm),du(ijb_u:ije_u,llm) REAL dteta(ijb_u:ije_u,llm),dp(ijb_u:ije_u) REAL w(ijb_u:ije_u,llm) REAL pbaru(ijb_u:ije_u,llm),pbarv(ijb_v:ije_v,llm) REAL time c Local: c ------ INTEGER ij,l,ijb,ije,ierr c----------------------------------------------------------------------- c Calcul des tendances dynamiques: c -------------------------------- CALL covcont_loc ( llm , ucov , vcov , ucont, vcont ) CALL pression_loc ( ip1jmp1, ap , bp , ps , p ) cym CALL psextbar ( ps , psexbarxy ) c$OMP BARRIER CALL massdair_loc ( p , masse ) CALL massbar_loc ( masse, massebx , masseby ) call massbarxy_loc( masse, massebxy ) CALL flumass_loc ( massebx, masseby,vcont,ucont,pbaru,pbarv ) CALL dteta1_loc ( teta , pbaru , pbarv, dteta ) CALL convmas1_loc ( pbaru, pbarv , convm ) c$OMP BARRIER CALL convmas2_loc ( convm ) c$OMP BARRIER #ifdef DEBUG_IO call WriteField_u('ucont',ucont) call WriteField_v('vcont',vcont) call WriteField_u('p',p) call WriteField_u('masse',masse) call WriteField_u('massebx',massebx) call WriteField_v('masseby',masseby) call WriteField_v('massebxy',massebxy) call WriteField_u('pbaru',pbaru) call WriteField_v('pbarv',pbarv) call WriteField_u('dteta',dteta) call WriteField_u('convm',convm) #endif c$OMP BARRIER c$OMP MASTER ijb=ij_begin ije=ij_end DO ij =ijb, ije dp( ij ) = convm( ij,1 ) / airesurg( ij ) ENDDO c$OMP END MASTER c$OMP BARRIER CALL vitvert_loc ( convm , w ) CALL tourpot_loc ( vcov , ucov , massebxy , vorpot ) CALL dudv1_loc ( vorpot , pbaru , pbarv , du , dv ) #ifdef DEBUG_IO call WriteField_u('w',w) call WriteField_v('vorpot',vorpot) call WriteField_u('du',du) call WriteField_v('dv',dv) #endif CALL enercin_loc ( vcov , ucov , vcont , ucont , ecin ) CALL bernoui_loc ( ip1jmp1, llm , phi , ecin , bern) CALL dudv2_loc ( teta , pkf , bern , du , dv ) #ifdef DEBUG_IO call WriteField_u('ecin',ecin) call WriteField_u('bern',bern) call WriteField_u('du',du) call WriteField_v('dv',dv) call WriteField_u('pkf',pkf) #endif ijb=ij_begin-iip1 ije=ij_end+iip1 if (pole_nord) ijb=ij_begin if (pole_sud) ije=ij_end c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l=1,llm DO ij=ijb,ije ang(ij,l) = ucov(ij,l) + constang(ij) ENDDO ENDDO c$OMP END DO CALL advect_new_loc(ang,vcov,teta,w,massebx,masseby,du,dv,dteta) C WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi C probablement. Observe sur le code compile avec pgf90 3.0-1 ijb=ij_begin ije=ij_end if (pole_sud) ije=ij_end-iip1 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l = 1, llm DO ij = ijb, ije, iip1 IF( dv(ij,l).NE.dv(ij+iim,l) ) THEN c PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov', c , ' dans caldyn' c PRINT *,' l, ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l) dv(ij+iim,l) = dv(ij,l) endif enddo enddo c$OMP END DO NOWAIT RETURN END