Changeset 1707 for LMDZ5/branches/testing/libf/dyn3dmem/integrd_loc.F

Timestamp:

Jan 11, 2013, 10:19:19 AM (11 years ago)

Author:

Laurent Fairhead

Message:

Version testing basée sur la r1706

---

Testing release based on r1706

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/dyn3dmem/integrd_loc.F (modified) (9 diffs)

LMDZ5/branches/testing/libf/dyn3dmem/integrd_loc.F

@@ -4 +4 @@
       SUBROUTINE integrd_loc
      $  (  nq,vcovm1,ucovm1,tetam1,psm1,massem1,
-     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis,finvmaold)
+     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis) !,finvmaold)
       USE parallel
       USE control_mod
@@ -37 +37 @@
 #include "temps.h"
 #include "serre.h"
-      include 'mpif.h'
+#include "iniprint.h"
+!      include 'mpif.h'
 
 c   Arguments:
 c   ----------
 
-      INTEGER nq
-
-      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
-      REAL teta(ijb_u:ije_u,llm)
-      REAL q(ijb_u:ije_u,llm,nq)
-      REAL ps0(ijb_u:ije_u),masse(ijb_u:ije_u,llm),phis(ijb_u:ije_u)
-
-      REAL vcovm1(ijb_v:ije_v,llm),ucovm1(ijb_u:ije_u,llm)
-      REAL tetam1(ijb_u:ije_u,llm),psm1(ijb_u:ije_u)
-      REAL massem1(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 dq(ijb_u:ije_u,llm,nq), finvmaold(ijb_u:ije_u,llm)
+      INTEGER,intent(in) :: nq ! number of tracers to handle in this routine
+
+      REAL,INTENT(INOUT) :: vcov(ijb_v:ije_v,llm) ! covariant meridional wind
+      REAL,INTENT(INOUT) :: ucov(ijb_u:ije_u,llm) ! covariant zonal wind
+      REAL,INTENT(INOUT) :: teta(ijb_u:ije_u,llm) ! potential temperature
+      REAL,INTENT(INOUT) :: q(ijb_u:ije_u,llm,nq) ! advected tracers
+      REAL,INTENT(INOUT) :: ps0(ijb_u:ije_u) ! surface pressure
+      REAL,INTENT(INOUT) :: masse(ijb_u:ije_u,llm) ! atmospheric mass
+      REAL,INTENT(INOUT) :: phis(ijb_u:ije_u) ! ground geopotential !!! unused
+      ! values at previous time step
+      REAL,INTENT(INOUT) :: vcovm1(ijb_v:ije_v,llm)
+      REAL,INTENT(INOUT) :: ucovm1(ijb_u:ije_u,llm)
+      REAL,INTENT(INOUT) :: tetam1(ijb_u:ije_u,llm)
+      REAL,INTENT(INOUT) :: psm1(ijb_u:ije_u)
+      REAL,INTENT(INOUT) :: massem1(ijb_u:ije_u,llm)
+      ! the tendencies to add
+      REAL,INTENT(INOUT) :: dv(ijb_v:ije_v,llm)
+      REAL,INTENT(INOUT) :: du(ijb_u:ije_u,llm)
+      REAL,INTENT(INOUT) :: dteta(ijb_u:ije_u,llm)
+      REAL,INTENT(INOUT) :: dp(ijb_u:ije_u)
+      REAL,INTENT(INOUT) :: dq(ijb_u:ije_u,llm,nq) !!! unused
+!      REAL,INTENT(INOUT) ::finvmaold(ijb_u:ije_u,llm) !!! unused
 
 c   Local:
@@ -62 +71 @@
       REAL vscr( ijb_v:ije_v ),uscr( ijb_u:ije_u )
       REAL hscr( ijb_u:ije_u ),pscr(ijb_u:ije_u)
-      REAL massescr( ijb_u:ije_u,llm ), finvmasse(ijb_u:ije_u,llm)
+      REAL massescr( ijb_u:ije_u,llm )
+!      REAL finvmasse(ijb_u:ije_u,llm)
       REAL tpn,tps,tppn(iim),tpps(iim)
       REAL qpn,qps,qppn(iim),qpps(iim)
 
-      INTEGER  l,ij,iq
+      INTEGER  l,ij,iq,i,j
 
       REAL SSUM
@@ -74 +84 @@
       LOGICAL,SAVE :: checksum_all=.TRUE.
       INTEGER :: stop_it
-      INTEGER :: ierr,j
+      INTEGER :: ierr
 
 c-----------------------------------------------------------------------
@@ -137 +147 @@
 !     &                   MPI_LOGICAL,MPI_LOR,COMM_LMDZ,ierr)
       IF( .NOT. checksum ) THEN
-         PRINT*,' Au point ij = ',stop_it, ' , pression sol neg. '
-     &         , ps(stop_it)
-         STOP' dans integrd'
-      ENDIF
+          write(lunout,*) "integrd: negative surface pressure ",
+     &                                                ps(stop_it)
+         write(lunout,*) " at node ij =", stop_it
+         ! since ij=j+(i-1)*jjp1 , we have
+!         j=modulo(stop_it,jjp1)
+!         i=1+(stop_it-j)/jjp1
+!         write(lunout,*) " lon = ",rlonv(i)*180./pi, " deg",
+!     &                   " lat = ",rlatu(j)*180./pi, " deg"
+      ENDIF
+
 c$OMP END MASTER
 c$OMP BARRIER
@@ -160 +176 @@
         call WriteField_u('int_dteta',dteta)
         call WriteField_u('int_dp',dp)
-        call WriteField_u('int_finvmaold',finvmaold)
+!        call WriteField_u('int_finvmaold',finvmaold)
         do j=1,nq
           call WriteField_u('int_q'//trim(int2str(j)),
@@ -206 +222 @@
       CALL massdair_loc (     p  , masse         )
 
-c      CALL   SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
-      ijb=ij_begin
-      ije=ij_end
-      
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
-      DO  l = 1,llm
-        finvmasse(ijb:ije,l)=masse(ijb:ije,l)
-      ENDDO
-c$OMP END DO NOWAIT
-
-      jjb=jj_begin
-      jje=jj_end
-      CALL filtreg_p( finvmasse,jjb_u,jje_u,jjb,jje, jjp1, llm,
-     &                -2, 2, .TRUE., 1  )
+! Ehouarn : we don't use/need finvmaold and finvmasse,
+!           so might as well not compute them
+!c      CALL   SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
+!      ijb=ij_begin
+!      ije=ij_end
+!      
+!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
+!      DO  l = 1,llm
+!        finvmasse(ijb:ije,l)=masse(ijb:ije,l)
+!      ENDDO
+!c$OMP END DO NOWAIT
+
+!      jjb=jj_begin
+!      jje=jj_end
+!      CALL filtreg_p( finvmasse,jjb_u,jje_u,jjb,jje, jjp1, llm,
+!     &                -2, 2, .TRUE., 1  )
 c
 
@@ -320 +338 @@
 
           CALL qminimum_loc( q, nq, deltap )
-         endif ! of if (planet_type.eq."earth")
 c
 c    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....
@@ -371 +388 @@
       ENDIF
       
-c         CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l = 1, llm      
-        finvmaold(ijb:ije,l)=finvmasse(ijb:ije,l)        
-      ENDDO
-c$OMP END DO NOWAIT
+! Ehouarn: forget about finvmaold
+!c         CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
+
+!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+!      DO l = 1, llm      
+!        finvmaold(ijb:ije,l)=finvmasse(ijb:ije,l)        
+!      ENDDO
+!c$OMP END DO NOWAIT
+
+      endif ! of if (planet_type.eq."earth")
+
 c
 c