Changeset 2258 for LMDZ5/branches/testing/libf/phydev/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/phydev/iniphysiq.F90 (modified) (4 diffs)

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

@@ -2 +2 @@
 ! $Id: iniphysiq.F 1403 2010-07-01 09:02:53Z fairhead $
 !
-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
-  USE comcstphy, ONLY: rradius, rg, rr, rcpp
+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 comcstphy, ONLY: rradius, & ! planet radius (m)
+                       rr, & ! recuced gas constant: R/molar mass of atm
+                       rg, & ! gravity
+                       rcpp  ! specific heat of the atmosphere
   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
-  !
   !=======================================================================
  
@@ -34 +38 @@
   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) :: pdayref ! reference day of for the simulation
+  INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
+  INTEGER, INTENT (IN) :: iim ! number of atmospheric coulumns 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)
   INTEGER,INTENT(IN) :: iflag_phys ! type of physics to be called
 
   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.NE.klev) THEN
     WRITE(lunout,*) 'STOP in ',trim(modname)
@@ -58 +73 @@
   ENDIF
 
-  IF (ngrid.NE.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)
-  ENDIF
+  !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))
 
-  !$OMP PARALLEL PRIVATE(ibegin,iend) &
-  !$OMP          SHARED(parea,pcu,pcv,plon,plat)
-      
+    ! 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
+
+!$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)
 
   ! copy some fundamental parameters to physics
@@ -83 +135 @@
   rcpp=pcpp
 
-  !$OMP END PARALLEL
+!$OMP END PARALLEL
 
   ! Additional initializations for aquaplanets 
-  !$OMP PARALLEL
+!$OMP PARALLEL
   IF (iflag_phys>=100) THEN
     CALL iniaqua(klon_omp,rlatd,rlond,iflag_phys)
   ENDIF
-  !$OMP END PARALLEL
+!$OMP END PARALLEL
 
 END SUBROUTINE iniphysiq