Changeset 1395 for trunk/LMDZ.TITAN/libf


Ignore:
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

Location:
trunk/LMDZ.TITAN/libf/phytitan
Files:
1 edited
1 moved

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.TITAN/libf/phytitan/iniphysiq.F90

    r1394 r1395  
    1 !
    2 ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/iniphysiq.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
    3 !
    4 c
    5 c
    6       SUBROUTINE iniphysiq(ngrid,nlayer,
    7      $           punjours,
    8      $           pdayref,ptimestep,
    9      $           plat,plon,parea,pcu,pcv,
    10      $           prad,pg,pr,pcpp,iflag_phys)
    111
    12 c
    13 c=======================================================================
    14 c
    15 c   subject:
    16 c   --------
    17 c
    18 c   Initialisation for the physical parametrisations of the LMD
    19 c   martian atmospheric general circulation modele.
    20 c
    21 c   author: Frederic Hourdin 15 / 10 /93
    22 c   -------
    23 c
    24 c   arguments:
    25 c   ----------
    26 c
    27 c   input:
    28 c   ------
    29 c
    30 c    ngrid                 Size of the horizontal grid.
    31 c                          All internal loops are performed on that grid.
    32 c    nlayer                Number of vertical layers.
    33 c    pdayref               Day of reference for the simulation
    34 c    firstcall             True at the first call
    35 c    lastcall              True at the last call
    36 c    pday                  Number of days counted from the North. Spring
    37 c                          equinoxe.
    38 c
    39 c=======================================================================
    40 c
    41 c-----------------------------------------------------------------------
    42 c   declarations:
    43 c   -------------
    44  
    45       USE dimphy, only : klev
    46       USE mod_grid_phy_lmdz, only : klon_glo
    47       USE mod_phys_lmdz_para, only : klon_omp,klon_omp_begin,
    48      &                               klon_omp_end,klon_mpi_begin
    49       USE comgeomphy, only : airephy,cuphy,cvphy,rlond,rlatd
    50       IMPLICIT NONE
    51 #include "iniprint.h"
     2! $Id: iniphysiq.F90 2225 2015-03-11 14:55:23Z emillour $
    523
    53       REAL,INTENT(IN) :: prad ! radius of the planet (m)
    54       REAL,INTENT(IN) :: pg ! gravitational acceleration (m/s2)
    55       REAL,INTENT(IN) :: pr ! ! reduced gas constant R/mu
    56       REAL,INTENT(IN) :: pcpp ! specific heat Cp
    57       REAL,INTENT(IN) :: punjours ! length (in s) of a standard day
    58       INTEGER,INTENT(IN) :: ngrid ! number of horizontal grid points in the physics
    59       INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers
    60       REAL,INTENT(IN) :: plat(ngrid) ! latitudes of the physics grid
    61       REAL,INTENT(IN) :: plon(ngrid) ! longitudes of the physics grid
    62       REAL,INTENT(IN) :: parea(klon_glo) ! area (m2)
    63       REAL,INTENT(IN) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
    64       REAL,INTENT(IN) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
    65       INTEGER,INTENT(IN) :: pdayref ! reference day of for the simulation
    66       REAL,INTENT(IN) :: ptimestep !physics time step (s)
    67       INTEGER,INTENT(IN) :: iflag_phys ! type of physics to be called
    684
    69       INTEGER :: ibegin,iend,offset
    70       CHARACTER (LEN=20) :: modname='iniphysiq'
    71       CHARACTER (LEN=80) :: abort_message
    72  
    73       IF (nlayer.NE.klev) THEN
    74          write(lunout,*) 'STOP in ',trim(modname)
    75          write(lunout,*) 'Problem with dimensions :'
    76          write(lunout,*) 'nlayer     = ',nlayer
    77          write(lunout,*) 'klev   = ',klev
    78          abort_message = ''
    79          CALL abort_gcm (modname,abort_message,1)
     5SUBROUTINE iniphysiq(iim,jjm,nlayer,punjours, pdayref,ptimestep,         &
     6                     rlatu,rlonv,aire,cu,cv,                             &
     7                     prad,pg,pr,pcpp,iflag_phys)
     8  USE dimphy, ONLY: klev ! number of atmospheric levels
     9  USE mod_grid_phy_lmdz, ONLY: klon_glo ! number of atmospheric columns
     10                                        ! (on full grid)
     11  USE mod_phys_lmdz_para, ONLY: klon_omp, & ! number of columns (on local omp grid)
     12                                klon_omp_begin, & ! start index of local omp subgrid
     13                                klon_omp_end, & ! end index of local omp subgrid
     14                                klon_mpi_begin ! start indes of columns (on local mpi grid)
     15  USE comgeomphy, ONLY: initcomgeomphy, &
     16                        airephy, & ! physics grid area (m2)
     17                        cuphy, & ! cu coeff. (u_covariant = cu * u)
     18                        cvphy, & ! cv coeff. (v_covariant = cv * v)
     19                        rlond, & ! longitudes
     20                        rlatd ! latitudes
     21  IMPLICIT NONE
     22
     23  ! =======================================================================
     24  ! Initialisation of the physical constants and some positional and
     25  ! geometrical arrays for the physics
     26  ! =======================================================================
     27
     28  include "YOMCST.h"
     29  include "iniprint.h"
     30
     31  REAL, INTENT (IN) :: prad ! radius of the planet (m)
     32  REAL, INTENT (IN) :: pg ! gravitational acceleration (m/s2)
     33  REAL, INTENT (IN) :: pr ! ! reduced gas constant R/mu
     34  REAL, INTENT (IN) :: pcpp ! specific heat Cp
     35  REAL, INTENT (IN) :: punjours ! length (in s) of a standard day
     36  INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
     37  INTEGER, INTENT (IN) :: iim ! number of atmospheric columns along longitudes
     38  INTEGER, INTENT (IN) :: jjm ! number of atompsheric columns along latitudes
     39  REAL, INTENT (IN) :: rlatu(jjm+1) ! latitudes of the physics grid
     40  REAL, INTENT (IN) :: rlonv(iim+1) ! longitudes of the physics grid
     41  REAL, INTENT (IN) :: aire(iim+1,jjm+1) ! area of the dynamics grid (m2)
     42  REAL, INTENT (IN) :: cu((iim+1)*(jjm+1)) ! cu coeff. (u_covariant = cu * u)
     43  REAL, INTENT (IN) :: cv((iim+1)*jjm) ! cv coeff. (v_covariant = cv * v)
     44  INTEGER, INTENT (IN) :: pdayref ! reference day of for the simulation
     45  REAL, INTENT (IN) :: ptimestep !physics time step (s)
     46  INTEGER, INTENT (IN) :: iflag_phys ! type of physics to be called
     47
     48  INTEGER :: ibegin, iend, offset
     49  INTEGER :: i,j
     50  CHARACTER (LEN=20) :: modname = 'iniphysiq'
     51  CHARACTER (LEN=80) :: abort_message
     52  REAL :: total_area_phy, total_area_dyn
     53
     54
     55  ! global array, on full physics grid:
     56  REAL,ALLOCATABLE :: latfi(:)
     57  REAL,ALLOCATABLE :: lonfi(:)
     58  REAL,ALLOCATABLE :: cufi(:)
     59  REAL,ALLOCATABLE :: cvfi(:)
     60  REAL,ALLOCATABLE :: airefi(:)
     61
     62  IF (nlayer/=klev) THEN
     63    WRITE (lunout, *) 'STOP in ', trim(modname)
     64    WRITE (lunout, *) 'Problem with dimensions :'
     65    WRITE (lunout, *) 'nlayer     = ', nlayer
     66    WRITE (lunout, *) 'klev   = ', klev
     67    abort_message = ''
     68    CALL abort_gcm(modname, abort_message, 1)
     69  END IF
     70
     71  !call init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
     72 
     73  ! Generate global arrays on full physics grid
     74  ALLOCATE(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
     75  ALLOCATE(airefi(klon_glo))
     76
     77  IF (klon_glo>1) THEN ! general case
     78    ! North pole
     79    latfi(1)=rlatu(1)
     80    lonfi(1)=0.
     81    cufi(1) = cu(1)
     82    cvfi(1) = cv(1)
     83    DO j=2,jjm
     84      DO i=1,iim
     85        latfi((j-2)*iim+1+i)= rlatu(j)
     86        lonfi((j-2)*iim+1+i)= rlonv(i)
     87        cufi((j-2)*iim+1+i) = cu((j-1)*iim+1+i)
     88        cvfi((j-2)*iim+1+i) = cv((j-1)*iim+1+i)
     89      ENDDO
     90    ENDDO
     91    ! South pole
     92    latfi(klon_glo)= rlatu(jjm+1)
     93    lonfi(klon_glo)= 0.
     94    cufi(klon_glo) = cu((iim+1)*jjm+1)
     95    cvfi(klon_glo) = cv((iim+1)*jjm-iim)
     96
     97    ! build airefi(), mesh area on physics grid
     98    CALL gr_dyn_fi(1,iim+1,jjm+1,klon_glo,aire,airefi)
     99    ! Poles are single points on physics grid
     100    airefi(1)=sum(aire(1:iim,1))
     101    airefi(klon_glo)=sum(aire(1:iim,jjm+1))
     102
     103    ! Sanity check: do total planet area match between physics and dynamics?
     104    total_area_dyn=sum(aire(1:iim,1:jjm+1))
     105    total_area_phy=sum(airefi(1:klon_glo))
     106    IF (total_area_dyn/=total_area_phy) THEN
     107      WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
     108      WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
     109      WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
     110      IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
     111        ! stop here if the relative difference is more than 0.001%
     112        abort_message = 'planet total surface discrepancy'
     113        CALL abort_gcm(modname, abort_message, 1)
    80114      ENDIF
     115    ENDIF
     116  ELSE ! klon_glo==1, running the 1D model
     117    ! just copy over input values
     118    latfi(1)=rlatu(1)
     119    lonfi(1)=rlonv(1)
     120    cufi(1)=cu(1)
     121    cvfi(1)=cv(1)
     122    airefi(1)=aire(1,1)
     123  ENDIF ! of IF (klon_glo>1)
    81124
    82       IF (ngrid.NE.klon_glo) THEN
    83          write(lunout,*) 'STOP in ',trim(modname)
    84          write(lunout,*) 'Problem with dimensions :'
    85          write(lunout,*) 'ngrid     = ',ngrid
    86          write(lunout,*) 'klon   = ',klon_glo
    87          abort_message = ''
    88          CALL abort_gcm (modname,abort_message,1)
    89       ENDIF
     125!$OMP PARALLEL
     126  ! Now generate local lon/lat/cu/cv/area arrays
     127  CALL initcomgeomphy
    90128
    91 c$OMP PARALLEL PRIVATE(ibegin,iend)
    92 c$OMP+         SHARED(parea,pcu,pcv,plon,plat)
    93      
    94       offset=klon_mpi_begin-1
    95       airephy(1:klon_omp)=parea(offset+klon_omp_begin:
    96      &                          offset+klon_omp_end)
    97       cuphy(1:klon_omp)=pcu(offset+klon_omp_begin:offset+klon_omp_end)
    98       cvphy(1:klon_omp)=pcv(offset+klon_omp_begin:offset+klon_omp_end)
    99       rlond(1:klon_omp)=plon(offset+klon_omp_begin:offset+klon_omp_end)
    100       rlatd(1:klon_omp)=plat(offset+klon_omp_begin:offset+klon_omp_end)
     129  offset = klon_mpi_begin - 1
     130  airephy(1:klon_omp) = airefi(offset+klon_omp_begin:offset+klon_omp_end)
     131  cuphy(1:klon_omp) = cufi(offset+klon_omp_begin:offset+klon_omp_end)
     132  cvphy(1:klon_omp) = cvfi(offset+klon_omp_begin:offset+klon_omp_end)
     133  rlond(1:klon_omp) = lonfi(offset+klon_omp_begin:offset+klon_omp_end)
     134  rlatd(1:klon_omp) = latfi(offset+klon_omp_begin:offset+klon_omp_end)
    101135
    102       call suphec
     136  ! Initialize some physical constants
     137  call suphec
    103138
    104 c$OMP END PARALLEL
     139!$OMP END PARALLEL
    105140
    106 c     print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ'
    107 c     print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...'
     141  ! check that physical constants set in 'suphec' are coherent
     142  ! with values set in the dynamics:
     143  IF (rday/=punjours) THEN
     144    WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!'
     145    WRITE (lunout, *) '  in the dynamics punjours=', punjours
     146    WRITE (lunout, *) '   but in the physics RDAY=', rday
     147    IF (abs(rday-punjours)>0.01*punjour) THEN
     148        ! stop here if the relative difference is more than 1%
     149      abort_message = 'length of day discrepancy'
     150      CALL abort_gcm(modname, abort_message, 1)
     151    END IF
     152  END IF
    108153
    109 c      print*,'agagagagagagagagaga'
    110 c      print*,'klon_mpi_begin =', klon_mpi_begin
    111 c      print*,'klon_mpi_end =', klon_mpi_end
    112 c      print*,'klon_mpi =', klon_mpi
    113 c      print*,'klon_mpi_para_nb =', klon_mpi_para_nb
    114 c      print*,'klon_mpi_para_begin =', klon_mpi_para_begin
    115 c      print*,'klon_mpi_para_end  =', klon_mpi_para_end
    116 c      print*,'mpi_rank =', mpi_rank
    117 c      print*,'mpi_size =', mpi_size
    118 c      print*,'mpi_root =', mpi_root
    119 c      print*,'klon_glo =', klon_glo
    120 c      print*,'is_mpi_root =',is_mpi_root
    121 c      print*,'is_omp_root =',is_omp_root
     154  IF (rg/=pg) THEN
     155    WRITE (lunout, *) 'iniphysiq: gravity discrepancy !!!'
     156    WRITE (lunout, *) '     in the dynamics pg=', pg
     157    WRITE (lunout, *) '  but in the physics RG=', rg
     158    IF (abs(rg-pg)>0.01*pg) THEN
     159        ! stop here if the relative difference is more than 1%
     160      abort_message = 'gravity discrepancy'
     161      CALL abort_gcm(modname, abort_message, 1)
     162    END IF
     163  END IF
     164  IF (ra/=prad) THEN
     165    WRITE (lunout, *) 'iniphysiq: planet radius discrepancy !!!'
     166    WRITE (lunout, *) '   in the dynamics prad=', prad
     167    WRITE (lunout, *) '  but in the physics RA=', ra
     168    IF (abs(ra-prad)>0.01*prad) THEN
     169        ! stop here if the relative difference is more than 1%
     170      abort_message = 'planet radius discrepancy'
     171      CALL abort_gcm(modname, abort_message, 1)
     172    END IF
     173  END IF
     174  IF (rd/=pr) THEN
     175    WRITE (lunout, *) 'iniphysiq: reduced gas constant discrepancy !!!'
     176    WRITE (lunout, *) '     in the dynamics pr=', pr
     177    WRITE (lunout, *) '  but in the physics RD=', rd
     178    IF (abs(rd-pr)>0.01*pr) THEN
     179        ! stop here if the relative difference is more than 1%
     180      abort_message = 'reduced gas constant discrepancy'
     181      CALL abort_gcm(modname, abort_message, 1)
     182    END IF
     183  END IF
     184  IF (rcpd/=pcpp) THEN
     185    WRITE (lunout, *) 'iniphysiq: specific heat discrepancy !!!'
     186    WRITE (lunout, *) '     in the dynamics pcpp=', pcpp
     187    WRITE (lunout, *) '  but in the physics RCPD=', rcpd
     188    IF (abs(rcpd-pcpp)>0.01*pcpp) THEN
     189        ! stop here if the relative difference is more than 1%
     190      abort_message = 'specific heat discrepancy'
     191      CALL abort_gcm(modname, abort_message, 1)
     192    END IF
     193  END IF
    122194
    123 ! pas d'inifis ici...
    124 ! est-ce que cursor est utile ? Voir avec Aymeric
    125 !      cursor = klon_mpi_begin
    126 !      print*, "CURSOR !!!!", mpi_rank, cursor
    127 
    128       RETURN
    129       END
     195END SUBROUTINE iniphysiq

  • trunk/LMDZ.TITAN/libf/phytitan/rcm1d.F

    r1300 r1395  
    205205      phisfi(1)=0.E+0
    206206
    207       CALL iniphysiq(1,llm,daysec,day0,dtphys,
    208      .            lati,long,area,cufi,cvfi,rad,g,r,cpp)
     207      CALL iniphysiq(1,1,llm,daysec,day0,dtphys,
     208     .            lati,long,area,cufi,cvfi,rad,g,r,cpp,1)
    209209
    210210c   Initialisation pour prendre en compte les vents en 1-D
Note: See TracChangeset for help on using the changeset viewer.