Changeset 1395 for trunk/LMDZ.VENUS/libf/phyvenus/iniphysiq.F90

Timestamp:

Mar 12, 2015, 12:45:17 PM (10 years ago)

Author:

emillour

Message:

All GCMS:
Some cleanup and tidying on the dynamics/physics interface.
Essentially affects the "iniphysiq" routine in all physics packages.
EM

File:

• trunk/LMDZ.VENUS/libf/phyvenus/iniphysiq.F90 (moved) (moved from trunk/LMDZ.VENUS/libf/phyvenus/iniphysiq.F) (1 diff)

trunk/LMDZ.VENUS/libf/phyvenus/iniphysiq.F90

@@ -1 @@
-!
-! $Header: /home/cvsroot/LMDZ4/libf/phylmd/iniphysiq.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
-!
-c
-c
-      SUBROUTINE iniphysiq(ngrid,nlayer,
-     $           punjours,
-     $           pdayref,ptimestep,
-     $           plat,plon,parea,pcu,pcv,
-     $           prad,pg,pr,pcpp,iflag_phys)
 
-c
-c=======================================================================
-c
-c   subject:
-c   --------
-c
-c   Initialisation for the physical parametrisations of the LMD 
-c   martian atmospheric general circulation modele.
-c
-c   author: Frederic Hourdin 15 / 10 /93
-c   -------
-c
-c   arguments:
-c   ----------
-c
-c   input:
-c   ------
-c
-c    ngrid                 Size of the horizontal grid.
-c                          All internal loops are performed on that grid.
-c    nlayer                Number of vertical layers.
-c    pdayref               Day of reference for the simulation
-c    firstcall             True at the first call
-c    lastcall              True at the last call
-c    pday                  Number of days counted from the North. Spring
-c                          equinoxe.
-c
-c=======================================================================
-c
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
- 
-      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
-      IMPLICIT NONE
-#include "iniprint.h"
+! $Id: iniphysiq.F90 2225 2015-03-11 14:55:23Z emillour $
 
-      REAL,INTENT(IN) :: prad ! radius of the planet (m)
-      REAL,INTENT(IN) :: pg ! gravitational acceleration (m/s2)
-      REAL,INTENT(IN) :: pr ! ! reduced gas constant R/mu
-      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
-      REAL,INTENT(IN) :: ptimestep !physics time step (s)
-      INTEGER,INTENT(IN) :: iflag_phys ! type of physics to be called
 
-      INTEGER :: ibegin,iend,offset
-      CHARACTER (LEN=20) :: modname='iniphysiq'
-      CHARACTER (LEN=80) :: abort_message
- 
-      IF (nlayer.NE.klev) THEN
-         write(lunout,*) 'STOP in ',trim(modname)
-         write(lunout,*) 'Problem with dimensions :'
-         write(lunout,*) 'nlayer     = ',nlayer
-         write(lunout,*) 'klev   = ',klev
-         abort_message = ''
-         CALL abort_gcm (modname,abort_message,1)
+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
+  IMPLICIT NONE
+
+  ! =======================================================================
+  ! Initialisation of the physical constants and some positional and
+  ! geometrical arrays for the physics
+  ! =======================================================================
+
+  include "YOMCST.h"
+  include "iniprint.h"
+
+  REAL, INTENT (IN) :: prad ! radius of the planet (m)
+  REAL, INTENT (IN) :: pg ! gravitational acceleration (m/s2)
+  REAL, INTENT (IN) :: pr ! ! reduced gas constant R/mu
+  REAL, INTENT (IN) :: pcpp ! specific heat Cp
+  REAL, INTENT (IN) :: punjours ! length (in s) of a standard day
+  INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
+  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)
+  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/=klev) THEN
+    WRITE (lunout, *) 'STOP in ', trim(modname)
+    WRITE (lunout, *) 'Problem with dimensions :'
+    WRITE (lunout, *) 'nlayer     = ', nlayer
+    WRITE (lunout, *) 'klev   = ', klev
+    abort_message = ''
+    CALL abort_gcm(modname, abort_message, 1)
+  END IF
+
+  !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)
 
-      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
+!$OMP PARALLEL 
+  ! Now generate local lon/lat/cu/cv/area arrays
+  CALL initcomgeomphy
 
-c$OMP PARALLEL PRIVATE(ibegin,iend) 
-c$OMP+         SHARED(parea,pcu,pcv,plon,plat)
-      
-      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)
+  offset = klon_mpi_begin - 1
+  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)
 
-      call suphec
+  ! Initialize some physical constants
+  call suphec
 
-c$OMP END PARALLEL
+!$OMP END PARALLEL
 
-c     print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ'
-c     print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...'
+  ! check that physical constants set in 'suphec' are coherent
+  ! with values set in the dynamics:
+  IF (rday/=punjours) THEN
+    WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!'
+    WRITE (lunout, *) '  in the dynamics punjours=', punjours
+    WRITE (lunout, *) '   but in the physics RDAY=', rday
+    IF (abs(rday-punjours)>0.01*punjour) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'length of day discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
 
-c      print*,'agagagagagagagagaga'
-c      print*,'klon_mpi_begin =', klon_mpi_begin
-c      print*,'klon_mpi_end =', klon_mpi_end
-c      print*,'klon_mpi =', klon_mpi
-c      print*,'klon_mpi_para_nb =', klon_mpi_para_nb
-c      print*,'klon_mpi_para_begin =', klon_mpi_para_begin
-c      print*,'klon_mpi_para_end  =', klon_mpi_para_end
-c      print*,'mpi_rank =', mpi_rank
-c      print*,'mpi_size =', mpi_size
-c      print*,'mpi_root =', mpi_root
-c      print*,'klon_glo =', klon_glo
-c      print*,'is_mpi_root =',is_mpi_root
-c      print*,'is_omp_root =',is_omp_root
+  IF (rg/=pg) THEN
+    WRITE (lunout, *) 'iniphysiq: gravity discrepancy !!!'
+    WRITE (lunout, *) '     in the dynamics pg=', pg
+    WRITE (lunout, *) '  but in the physics RG=', rg
+    IF (abs(rg-pg)>0.01*pg) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'gravity discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (ra/=prad) THEN
+    WRITE (lunout, *) 'iniphysiq: planet radius discrepancy !!!'
+    WRITE (lunout, *) '   in the dynamics prad=', prad
+    WRITE (lunout, *) '  but in the physics RA=', ra
+    IF (abs(ra-prad)>0.01*prad) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'planet radius discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (rd/=pr) THEN
+    WRITE (lunout, *) 'iniphysiq: reduced gas constant discrepancy !!!'
+    WRITE (lunout, *) '     in the dynamics pr=', pr
+    WRITE (lunout, *) '  but in the physics RD=', rd
+    IF (abs(rd-pr)>0.01*pr) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'reduced gas constant discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (rcpd/=pcpp) THEN
+    WRITE (lunout, *) 'iniphysiq: specific heat discrepancy !!!'
+    WRITE (lunout, *) '     in the dynamics pcpp=', pcpp
+    WRITE (lunout, *) '  but in the physics RCPD=', rcpd
+    IF (abs(rcpd-pcpp)>0.01*pcpp) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'specific heat discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
 
-! pas d'inifis ici... 
-! est-ce que cursor est utile ? Voir avec Aymeric
-!      cursor = klon_mpi_begin
-!      print*, "CURSOR !!!!", mpi_rank, cursor
-
-      RETURN
-      END
+END SUBROUTINE iniphysiq