Changeset 2258 for LMDZ5/branches/testing/libf/phylmd/iniphysiq.F90

Timestamp:

Apr 13, 2015, 10:21:09 AM (10 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes 2216:2237 into testing branch

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/phylmd/iniphysiq.F90 (modified) (6 diffs)

LMDZ5/branches/testing/libf/phylmd/iniphysiq.F90

@@ -3 +3 @@
 
 
-
-SUBROUTINE iniphysiq(ngrid, nlayer, punjours, pdayref, ptimestep, plat, plon, &
-    parea, pcu, pcv, prad, pg, pr, pcpp, iflag_phys)
-  USE dimphy, ONLY: klev
-  USE mod_grid_phy_lmdz, ONLY: klon_glo
-  USE mod_phys_lmdz_para, ONLY: klon_omp, klon_omp_begin, klon_omp_end, &
-    klon_mpi_begin
-  USE comgeomphy, ONLY: airephy, cuphy, cvphy, rlond, rlatd
+SUBROUTINE iniphysiq(iim,jjm,nlayer,punjours, pdayref,ptimestep,         &
+                     rlatu,rlonv,aire,cu,cv,                             &
+                     prad,pg,pr,pcpp,iflag_phys)
+  USE dimphy, ONLY: klev ! number of atmospheric levels
+  USE mod_grid_phy_lmdz, ONLY: klon_glo ! number of atmospheric columns
+                                        ! (on full grid)
+  USE mod_phys_lmdz_para, ONLY: klon_omp, & ! number of columns (on local omp grid)
+                                klon_omp_begin, & ! start index of local omp subgrid
+                                klon_omp_end, & ! end index of local omp subgrid
+                                klon_mpi_begin ! start indes of columns (on local mpi grid)
+  USE comgeomphy, ONLY: initcomgeomphy, &
+                        airephy, & ! physics grid area (m2)
+                        cuphy, & ! cu coeff. (u_covariant = cu * u)
+                        cvphy, & ! cv coeff. (v_covariant = cv * v)
+                        rlond, & ! longitudes
+                        rlatd ! latitudes
   USE phyaqua_mod, ONLY: iniaqua
   IMPLICIT NONE
 
   ! =======================================================================
-
   ! Initialisation of the physical constants and some positional and
   ! geometrical arrays for the physics
-
-
-  ! ngrid                 Size of the horizontal grid.
-  ! All internal loops are performed on that grid.
-  ! nlayer                Number of vertical layers.
-  ! pdayref               Day of reference for the simulation
-
   ! =======================================================================
 
-  ! ym#include "dimensions.h"
-  ! ym#include "dimphy.h"
-  ! ym#include "comgeomphy.h"
   include "YOMCST.h"
   include "iniprint.h"
@@ -38 +35 @@
   REAL, INTENT (IN) :: pcpp ! specific heat Cp
   REAL, INTENT (IN) :: punjours ! length (in s) of a standard day
-  INTEGER, INTENT (IN) :: ngrid ! number of horizontal grid points in the physics
   INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
-  REAL, INTENT (IN) :: plat(ngrid) ! latitudes of the physics grid
-  REAL, INTENT (IN) :: plon(ngrid) ! longitudes of the physics grid
-  REAL, INTENT (IN) :: parea(klon_glo) ! area (m2)
-  REAL, INTENT (IN) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
-  REAL, INTENT (IN) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
+  INTEGER, INTENT (IN) :: iim ! number of atmospheric columns along longitudes
+  INTEGER, INTENT (IN) :: jjm ! number of atompsheric columns along latitudes
+  REAL, INTENT (IN) :: rlatu(jjm+1) ! latitudes of the physics grid
+  REAL, INTENT (IN) :: rlonv(iim+1) ! longitudes of the physics grid
+  REAL, INTENT (IN) :: aire(iim+1,jjm+1) ! area of the dynamics grid (m2)
+  REAL, INTENT (IN) :: cu((iim+1)*(jjm+1)) ! cu coeff. (u_covariant = cu * u)
+  REAL, INTENT (IN) :: cv((iim+1)*jjm) ! cv coeff. (v_covariant = cv * v)
   INTEGER, INTENT (IN) :: pdayref ! reference day of for the simulation
   REAL, INTENT (IN) :: ptimestep !physics time step (s)
@@ -50 +48 @@
 
   INTEGER :: ibegin, iend, offset
+  INTEGER :: i,j
   CHARACTER (LEN=20) :: modname = 'iniphysiq'
   CHARACTER (LEN=80) :: abort_message
+  REAL :: total_area_phy, total_area_dyn
+
+
+  ! global array, on full physics grid:
+  REAL,ALLOCATABLE :: latfi(:)
+  REAL,ALLOCATABLE :: lonfi(:)
+  REAL,ALLOCATABLE :: cufi(:)
+  REAL,ALLOCATABLE :: cvfi(:)
+  REAL,ALLOCATABLE :: airefi(:)
 
   IF (nlayer/=klev) THEN
@@ -62 +70 @@
   END IF
 
-  IF (ngrid/=klon_glo) THEN
-    WRITE (lunout, *) 'STOP in ', trim(modname)
-    WRITE (lunout, *) 'Problem with dimensions :'
-    WRITE (lunout, *) 'ngrid     = ', ngrid
-    WRITE (lunout, *) 'klon   = ', klon_glo
-    abort_message = ''
-    CALL abort_gcm(modname, abort_message, 1)
-  END IF
-
-  !$OMP PARALLEL PRIVATE(ibegin,iend) &
-  !$OMP          SHARED(parea,pcu,pcv,plon,plat)
+  !call init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
+  
+  ! Generate global arrays on full physics grid
+  ALLOCATE(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
+  ALLOCATE(airefi(klon_glo))
+
+  IF (klon_glo>1) THEN ! general case
+    ! North pole
+    latfi(1)=rlatu(1)
+    lonfi(1)=0.
+    cufi(1) = cu(1)
+    cvfi(1) = cv(1)
+    DO j=2,jjm
+      DO i=1,iim
+        latfi((j-2)*iim+1+i)= rlatu(j)
+        lonfi((j-2)*iim+1+i)= rlonv(i)
+        cufi((j-2)*iim+1+i) = cu((j-1)*iim+1+i)
+        cvfi((j-2)*iim+1+i) = cv((j-1)*iim+1+i)
+      ENDDO
+    ENDDO
+    ! South pole
+    latfi(klon_glo)= rlatu(jjm+1)
+    lonfi(klon_glo)= 0.
+    cufi(klon_glo) = cu((iim+1)*jjm+1)
+    cvfi(klon_glo) = cv((iim+1)*jjm-iim)
+
+    ! build airefi(), mesh area on physics grid
+    CALL gr_dyn_fi(1,iim+1,jjm+1,klon_glo,aire,airefi)
+    ! Poles are single points on physics grid
+    airefi(1)=sum(aire(1:iim,1))
+    airefi(klon_glo)=sum(aire(1:iim,jjm+1))
+
+    ! Sanity check: do total planet area match between physics and dynamics?
+    total_area_dyn=sum(aire(1:iim,1:jjm+1))
+    total_area_phy=sum(airefi(1:klon_glo))
+    IF (total_area_dyn/=total_area_phy) THEN
+      WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
+      WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
+      WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
+      IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
+        ! stop here if the relative difference is more than 0.001%
+        abort_message = 'planet total surface discrepancy'
+        CALL abort_gcm(modname, abort_message, 1)
+      ENDIF
+    ENDIF
+  ELSE ! klon_glo==1, running the 1D model
+    ! just copy over input values
+    latfi(1)=rlatu(1)
+    lonfi(1)=rlonv(1)
+    cufi(1)=cu(1)
+    cvfi(1)=cv(1)
+    airefi(1)=aire(1,1)
+  ENDIF ! of IF (klon_glo>1)
+
+!$OMP PARALLEL 
+  ! Now generate local lon/lat/cu/cv/area arrays
+  CALL initcomgeomphy
 
   offset = klon_mpi_begin - 1
-  airephy(1:klon_omp) = parea(offset+klon_omp_begin:offset+klon_omp_end)
-  cuphy(1:klon_omp) = pcu(offset+klon_omp_begin:offset+klon_omp_end)
-  cvphy(1:klon_omp) = pcv(offset+klon_omp_begin:offset+klon_omp_end)
-  rlond(1:klon_omp) = plon(offset+klon_omp_begin:offset+klon_omp_end)
-  rlatd(1:klon_omp) = plat(offset+klon_omp_begin:offset+klon_omp_end)
+  airephy(1:klon_omp) = airefi(offset+klon_omp_begin:offset+klon_omp_end)
+  cuphy(1:klon_omp) = cufi(offset+klon_omp_begin:offset+klon_omp_end)
+  cvphy(1:klon_omp) = cvfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlond(1:klon_omp) = lonfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlatd(1:klon_omp) = latfi(offset+klon_omp_begin:offset+klon_omp_end)
 
     ! suphel => initialize some physical constants (orbital parameters,
@@ -86 +140 @@
   CALL suphel
 
-  !$OMP END PARALLEL
-
-    ! check that physical constants set in 'suphel' are coherent
-    ! with values set in the dynamics:
+!$OMP END PARALLEL
+
+  ! check that physical constants set in 'suphel' are coherent
+  ! with values set in the dynamics:
   IF (rday/=punjours) THEN
     WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!'
@@ -142 +196 @@
 
   ! Additional initializations for aquaplanets
-  !$OMP PARALLEL
+!$OMP PARALLEL
   IF (iflag_phys>=100) THEN
     CALL iniaqua(klon_omp, rlatd, rlond, iflag_phys)
   END IF
-  !$OMP END PARALLEL
-
-  ! RETURN
-  ! 9999  CONTINUE
-  ! abort_message ='Cette version demande les fichier rnatur.dat
-  ! & et surf.def'
-  ! CALL abort_gcm (modname,abort_message,1)
+!$OMP END PARALLEL
 
 END SUBROUTINE iniphysiq