Changeset 2160 for LMDZ5/branches/testing/libf/dyn3dmem

Timestamp:

Nov 28, 2014, 4:36:29 PM (10 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes -r2070:2158 into testing branch. Compilation problems introduced by revision r2155 have been corrected by hand

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/dyn3dmem/abort_gcm.F (modified) (2 diffs)
• libf/dyn3dmem/conf_gcm.F (deleted)
• libf/dyn3dmem/conf_gcm.F90 (copied) (copied from LMDZ5/trunk/libf/dyn3dmem/conf_gcm.F90)
• libf/dyn3dmem/gcm.F (modified) (1 diff)
• libf/dyn3dmem/getparam.F90 (modified) (1 diff)
• libf/dyn3dmem/guide_loc_mod.F90 (modified) (5 diffs)
• libf/dyn3dmem/iniacademic_loc.F90 (modified) (3 diffs)
• libf/dyn3dmem/integrd_loc.F (modified) (3 diffs)
• libf/dyn3dmem/mod_filtreg_p.F (modified) (10 diffs)

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

@@ -23 +23 @@
 C         ierr    = severity of situation ( = 0 normal )
 
-      character(len=*) modname
+      character(len=*), intent(in):: modname
       integer ierr, ierror_mpi
-      character(len=*) message
+      character(len=*), intent(in):: message
 
       write(lunout,*) 'in abort_gcm'
@@ -46 +46 @@
         write(lunout,*) 'Everything is cool'
       else
-        write(lunout,*) 'Houston, we have a problem ', ierr
+        write(lunout,*) 'Houston, we have a problem, ierr = ', ierr
 #ifdef CPP_MPI
 C$OMP CRITICAL (MPI_ABORT_GCM)

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

@@ -174 +174 @@
 !#ifdef CPP_IOIPSL
       CALL conf_gcm( 99, .TRUE. , clesphy0 )
+      if (mod(iphysiq, iperiod) /= 0) call abort_gcm("conf_gcm",
+     s "iphysiq must be a multiple of iperiod", 1)
 !#else
 !      CALL defrun( 99, .TRUE. , clesphy0 )

LMDZ5/branches/testing/libf/dyn3dmem/getparam.F90

@@ -11 +11 @@
 
    INTERFACE getpar
-     MODULE PROCEDURE ini_getparam,fin_getparam,getparamr,getparami,getparaml
+     MODULE PROCEDURE getparamr,getparami,getparaml
    END INTERFACE
+   private getparamr,getparami,getparaml
 
    INTEGER, PARAMETER :: out_eff=99

LMDZ5/branches/testing/libf/dyn3dmem/guide_loc_mod.F90

@@ -68 +68 @@
 
   SUBROUTINE guide_init
-    
+
     USE control_mod
+
     IMPLICIT NONE
   
@@ -75 +76 @@
     INCLUDE "paramet.h"
     INCLUDE "netcdf.inc"
+
+    ! For grossismx:
+    include "serre.h"
 
     INTEGER                :: error,ncidpl,rid,rcod
@@ -94 +98 @@
     CALL getpar('guide_add',.false.,guide_add,'for�age constant?')
     CALL getpar('guide_zon',.false.,guide_zon,'guidage moy zonale')
+    if (guide_zon .and. abs(grossismx - 1.) > 0.01) &
+         call abort_gcm("guide_init", &
+         "zonal nudging requires grid regular in longitude", 1)
 
 !   Constantes de rappel. Unite : fraction de jour
@@ -114 +121 @@
     ! frequences f>0: fx/jour; f<0: tous les f jours; f=0: 1 seule fois.
     IF (iguide_sav.GT.0) THEN
-        iguide_sav=day_step/iguide_sav
+       iguide_sav=day_step/iguide_sav
+    ELSE if (iguide_sav == 0) then
+       iguide_sav = huge(0)
     ELSE
-        iguide_sav=day_step*iguide_sav
+       iguide_sav=day_step*iguide_sav
     ENDIF
 
@@ -1517 +1526 @@
             enddo
         enddo
-    
     ENDIF ! guide_reg
+
+    if (.not. guide_add) alpha = 1. - exp(- alpha)
 
   END SUBROUTINE tau2alpha

LMDZ5/branches/testing/libf/dyn3dmem/iniacademic_loc.F90

@@ -4 +4 @@
 SUBROUTINE iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
 
+  USE filtreg_mod, ONLY: inifilr
   use exner_hyb_m, only: exner_hyb
   use exner_milieu_m, only: exner_milieu
-  USE filtreg_mod
   USE infotrac, ONLY : nqtot
   USE control_mod, ONLY: day_step,planet_type
-  USE parallel_lmdz
+  USE parallel_lmdz, ONLY: ijb_u, ije_u, ijb_v, ije_v
 #ifdef CPP_IOIPSL
-  USE IOIPSL
+  USE IOIPSL, ONLY: getin
 #else
   ! if not using IOIPSL, we still need to use (a local version of) getin
-  USE ioipsl_getincom
+  USE ioipsl_getincom, ONLY: getin
 #endif
   USE Write_Field
@@ -41 +41 @@
   !   ----------
 
-  real time_0
-
-  !   variables dynamiques
-  REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm) ! vents covariants
-  REAL teta(ijb_u:ije_u,llm)                 ! temperature potentielle
-  REAL q(ijb_u:ije_u,llm,nqtot)               ! champs advectes
-  REAL ps(ijb_u:ije_u)                       ! pression  au sol
-  REAL masse(ijb_u:ije_u,llm)                ! masse d'air
-  REAL phis(ijb_u:ije_u)                     ! geopotentiel au sol
+  REAL,INTENT(OUT) :: time_0
+
+  !   fields
+  REAL,INTENT(OUT) :: vcov(ijb_v:ije_v,llm) ! meridional covariant wind
+  REAL,INTENT(OUT) :: ucov(ijb_u:ije_u,llm) ! zonal covariant wind
+  REAL,INTENT(OUT) :: teta(ijb_u:ije_u,llm) ! potential temperature (K)
+  REAL,INTENT(OUT) :: q(ijb_u:ije_u,llm,nqtot) ! advected tracers (.../kg_of_air)
+  REAL,INTENT(OUT) :: ps(ijb_u:ije_u) ! surface pressure (Pa)
+  REAL,INTENT(OUT) :: masse(ijb_u:ije_u,llm) ! air mass in grid cell (kg)
+  REAL,INTENT(OUT) :: phis(ijb_u:ije_u) ! surface geopotential
 
   !   Local:
@@ -80 +81 @@
   character(len=80) :: abort_message
 
+  ! Sanity check: verify that options selected by user are not incompatible
+  if ((iflag_phys==1).and. .not. read_start) then
+    write(lunout,*) trim(modname)," error: if read_start is set to ", &
+    " false then iflag_phys should not be 1"
+    write(lunout,*) "You most likely want an aquaplanet initialisation", &
+    " (iflag_phys >= 100)"
+    call abort_gcm(modname,"incompatible iflag_phys==1 and read_start==.false.",1)
+  endif
+  
   !-----------------------------------------------------------------------
   ! 1. Initializations for Earth-like case

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

@@ -147 +147 @@
 !     &                   MPI_LOGICAL,MPI_LOR,COMM_LMDZ,ierr)
       IF( .NOT. checksum ) THEN
-          write(lunout,*) "integrd: negative surface pressure ",
-     &                                                ps(stop_it)
+         write(lunout,*) "integrd: ps = ", ps(stop_it)
          write(lunout,*) " at node ij =", stop_it
          ! since ij=j+(i-1)*jjp1 , we have
@@ -155 +154 @@
 !         write(lunout,*) " lon = ",rlonv(i)*180./pi, " deg",
 !     &                   " lat = ",rlatu(j)*180./pi, " deg"
+         call abort_gcm("integrd_loc", "negative surface pressure", 1)
       ENDIF
 
@@ -183 +183 @@
      .                dq(:,:,j))
         enddo
-      STOP
+        call abort_gcm("integrd_loc", "", 1)
       ENDIF
     

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

@@ -6 +6 @@
      &     ifiltre, iaire, griscal ,iter)
       USE parallel_lmdz, only : OMP_CHUNK
-      USE mod_filtre_fft_loc
-      USE timer_filtre
-      
-      USE filtreg_mod
+      USE mod_filtre_fft_loc, ONLY: use_filtre_fft, filtre_u_fft,
+     &                              filtre_v_fft, filtre_inv_fft
+      USE timer_filtre, ONLY: init_timer, start_timer, stop_timer
+      
+      USE filtreg_mod, ONLY: matrinvn, matrinvs, matriceun, matriceus,
+     &                       matricevn, matricevs
       
       IMPLICIT NONE
@@ -57 +59 @@
 #include "coefils.h"
 c
-      INTEGER jjb,jje,ibeg,iend,nlat,nbniv,ifiltre,iter
+      INTEGER,INTENT(IN) :: jjb,jje,ibeg,iend,nlat,nbniv,ifiltre,iter
+      INTEGER,INTENT(IN) :: iaire
+      LOGICAL,INTENT(IN) :: griscal
+      REAL,INTENT(INOUT) ::  champ( iip1,jjb:jje,nbniv)
+      
       INTEGER i,j,l,k
       INTEGER iim2,immjm
       INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
-      
-      REAL  champ( iip1,jjb:jje,nbniv)
-      
-      LOGICAL    griscal
-      INTEGER    hemisph, iaire
-      
+      INTEGER    hemisph
       REAL :: champ_fft(iip1,jjb:jje,nbniv)
-      REAL :: champ_in(iip1,jjb:jje,nbniv)
+!      REAL :: champ_in(iip1,jjb:jje,nbniv)
       
       LOGICAL,SAVE     :: first=.TRUE.
@@ -216 +217 @@
      &                    champ_fft(1,j,1), iip1*(jje-jjb+1))
 #else
-                     champ_fft(:,j,1:nbniv_loc)=
-     &                    matmul(matrinvn(:,:,j),
-     &                    champ_loc(:iim,j,1:nbniv_loc))
+                     champ_fft(1:iim,j,1:nbniv_loc)=
+     &                    matmul(matrinvn(1:iim,1:iim,j),
+     &                    champ_loc(1:iim,j,1:nbniv_loc))
 #endif
                   ENDDO
@@ -230 +231 @@
      &                    champ_fft(1,j,1), iip1*(jje-jjb+1))
 #else
-                     champ_fft(:,j,1:nbniv_loc)=
-     &                    matmul(matriceun(:,:,j),
-     &                           champ_loc(:iim,j,1:nbniv_loc))
+                     champ_fft(1:iim,j,1:nbniv_loc)=
+     &                    matmul(matriceun(1:iim,1:iim,j),
+     &                           champ_loc(1:iim,j,1:nbniv_loc))
 #endif
                   ENDDO
@@ -244 +245 @@
      &                    champ_fft(1,j,1), iip1*(jje-jjb+1))
 #else
-                     champ_fft(:,j,1:nbniv_loc)=
-     &                    matmul(matricevn(:,:,j),           
-     &                           champ_loc(:iim,j,1:nbniv_loc))
+                     champ_fft(1:iim,j,1:nbniv_loc)=
+     &                    matmul(matricevn(1:iim,1:iim,j),           
+     &                           champ_loc(1:iim,j,1:nbniv_loc))
 #endif
                   ENDDO
@@ -262 +263 @@
      &                    champ_fft(1,j,1), iip1*(jje-jjb+1))
 #else
-                     champ_fft(:,j,1:nbniv_loc)=
-     &                    matmul(matrinvs(:,:,j-jfiltsu+1),
-     &                           champ_loc(:iim,j,1:nbniv_loc))
+                     champ_fft(1:iim,j,1:nbniv_loc)=
+     &                    matmul(matrinvs(1:iim,1:iim,j-jfiltsu+1),
+     &                           champ_loc(1:iim,j,1:nbniv_loc))
 #endif
                   ENDDO
@@ -277 +278 @@
      &                    champ_fft(1,j,1), iip1*(jje-jjb+1))
 #else
-                     champ_fft(:,j,1:nbniv_loc)=
-     &                    matmul(matriceus(:,:,j-jfiltsu+1),
-     &                           champ_loc(:iim,j,1:nbniv_loc))
+                     champ_fft(1:iim,j,1:nbniv_loc)=
+     &                    matmul(matriceus(1:iim,1:iim,j-jfiltsu+1),
+     &                           champ_loc(1:iim,j,1:nbniv_loc))
 #endif
                   ENDDO
@@ -292 +293 @@
      &                    champ_fft(1,j,1), iip1*(jje-jjb+1))
 #else
-                     champ_fft(:,j,1:nbniv_loc)=
-     &                    matmul(matricevs(:,:,j-jfiltsv+1),
-     &                           champ_loc(:iim,j,1:nbniv_loc))
+                     champ_fft(1:iim,j,1:nbniv_loc)=
+     &                    matmul(matricevs(1:iim,1:iim,j-jfiltsv+1),
+     &                           champ_loc(1:iim,j,1:nbniv_loc))
 #endif
                   ENDDO
@@ -344 +345 @@
             DO l = 1, nbniv
                DO j = jdfil,jffil
+                  ! add redundant longitude
                   champ( iip1,j,l ) = champ( 1,j,l )
                ENDDO
@@ -406 +408 @@
                DO j=jdfil,jffil
 !            champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
+                  ! add redundant longitude
                   champ( iip1,j,l ) = champ( 1,j,l )
                ENDDO