Ignore:
Timestamp:
Dec 14, 2015, 11:43:09 AM (10 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r2298:2396 into testing branch

Location:
LMDZ5/branches/testing
Files:
2 deleted
7 edited
2 copied

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/phydev/iophy.F90

    r2160 r2408  
    4646                                is_sequential, is_south_pole
    4747  USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo
     48  USE print_control_mod, ONLY: lunout, prt_level
     49  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
    4850#ifdef CPP_IOIPSL
    4951  USE ioipsl, only: flio_dom_set
    … …  
    5355#endif
    5456  implicit none
    55   include 'dimensions.h'
    56   include 'iniprint.h'
    5757    real,dimension(klon),intent(in) :: rlon
    5858    real,dimension(klon),intent(in) :: rlat
    … …  
    7777   
    7878!$OMP MASTER 
    79     ALLOCATE(io_lat(jjm+1-1/(iim*jjm)))
     79    ALLOCATE(io_lat(nbp_lat))
    8080    io_lat(1)=rlat_glo(1)
    81     io_lat(jjm+1-1/(iim*jjm))=rlat_glo(klon_glo)
    82     IF ((iim*jjm) > 1) then
    83       DO i=2,jjm
    84         io_lat(i)=rlat_glo(2+(i-2)*iim)
     81    io_lat(nbp_lat)=rlat_glo(klon_glo)
     82    IF ((nbp_lon*nbp_lat) > 1) then
     83      DO i=2,nbp_lat-1
     84        io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
    8585      ENDDO
    8686    ENDIF
    8787
    88     ALLOCATE(io_lon(iim))
    89     io_lon(:)=rlon_glo(2-1/(iim*jjm):iim+1-1/(iim*jjm))
     88    ALLOCATE(io_lon(nbp_lon))
     89    IF ((nbp_lon*nbp_lat) > 1) THEN
     90      io_lon(:)=rlon_glo(2:nbp_lon+1)
     91    ELSE
     92      io_lon(1)=rlon_glo(1)
     93    ENDIF
    9094!! (I) dtnb   : total number of domains
    9195!! (I) dnb    : domain number
    … …  
    103107!!              These names are case insensitive.
    104108    ddid=(/ 1,2 /)
    105     dsg=(/ iim, jjm+1-1/(iim*jjm) /)
    106     dsl=(/ iim, jj_nb /)
     109    dsg=(/ nbp_lon, nbp_lat /)
     110    dsl=(/ nbp_lon, jj_nb /)
    107111    dpf=(/ 1,jj_begin /)
    108     dpl=(/ iim, jj_end /)
     112    dpl=(/ nbp_lon, jj_end /)
    109113    dhs=(/ ii_begin-1,0 /)
    110114    if (mpi_rank==mpi_size-1) then
    111115      dhe=(/0,0/)
    112116    else
    113       dhe=(/ iim-ii_end,0 /) 
     117      dhe=(/ nbp_lon-ii_end,0 /) 
    114118    endif
    115119   
    … …  
    155159  USE mod_phys_lmdz_para, only: is_sequential, jj_begin, jj_end, jj_nb
    156160  use ioipsl, only: histbeg
     161  USE print_control_mod, ONLY: prt_level, lunout
     162  USE mod_grid_phy_lmdz, ONLY: nbp_lon
    157163  implicit none
    158   include 'dimensions.h'
    159164   
    160165    character*(*), intent(IN) :: name
    … …  
    167172!$OMP MASTER   
    168173    if (is_sequential) then
    169       call histbeg(name,iim,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    170                    1,iim,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
     174      call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
     175                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
    171176    else
    172       call histbeg(name,iim,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    173                    1,iim,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
     177      call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
     178                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
    174179    endif
    175180!$OMP END MASTER
    … …  
    186191  use wxios, only: wxios_add_file
    187192  IMPLICIT NONE
    188   include 'dimensions.h'
    189193   
    190194    character*(*), INTENT(IN) :: name
    … …  
    219223                                jj_nb, klon_mpi
    220224  USE ioipsl, only: histwrite
     225  USE mod_grid_phy_lmdz, ONLY: nbp_lon
    221226  implicit none
    222   include 'dimensions.h'
    223227   
    224228    integer,intent(in) :: nid
    … …  
    229233    REAL,dimension(klon_mpi) :: buffer_omp
    230234    INTEGER, allocatable, dimension(:) :: index2d
    231     REAL :: Field2d(iim,jj_nb)
     235    REAL :: Field2d(nbp_lon,jj_nb)
    232236
    233237    integer :: ip
    234238    real,allocatable,dimension(:) :: fieldok
    235239
    236     IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first dimension not equal to klon',1)
     240    IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d','Field first dimension not equal to klon',1)
    237241   
    238242    CALL Gather_omp(field,buffer_omp)   
    … …  
    240244    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
    241245    if(.NOT.lpoint) THEN
    242      ALLOCATE(index2d(iim*jj_nb))
    243      ALLOCATE(fieldok(iim*jj_nb))
    244      CALL histwrite(nid,name,itau,Field2d,iim*jj_nb,index2d)
     246     ALLOCATE(index2d(nbp_lon*jj_nb))
     247     ALLOCATE(fieldok(nbp_lon*jj_nb))
     248     CALL histwrite(nid,name,itau,Field2d,nbp_lon*jj_nb,index2d)
    245249    else
    246250     ALLOCATE(fieldok(npstn))
    … …  
    278282                                jj_nb, klon_mpi
    279283  USE ioipsl, only: histwrite
     284  USE mod_grid_phy_lmdz, ONLY: nbp_lon
    280285  implicit none
    281   include 'dimensions.h'
    282286   
    283287    integer,intent(in) :: nid
    … …  
    287291    real,dimension(:,:),intent(in) :: field  ! --> field(klon,:)
    288292    REAL,dimension(klon_mpi,size(field,2)) :: buffer_omp
    289     REAL :: Field3d(iim,jj_nb,size(field,2))
     293    REAL :: Field3d(nbp_lon,jj_nb,size(field,2))
    290294    INTEGER :: ip, n, nlev
    291295    INTEGER, ALLOCATABLE, dimension(:) :: index3d
    292296    real,allocatable, dimension(:,:) :: fieldok
    293297
    294     IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first dimension not equal to klon',1)
     298    IF (size(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first dimension not equal to klon',1)
    295299    nlev=size(field,2)
    296300
    … …  
    299303    CALL grid1Dto2D_mpi(buffer_omp,field3d)
    300304    if(.NOT.lpoint) THEN
    301      ALLOCATE(index3d(iim*jj_nb*nlev))
    302      ALLOCATE(fieldok(iim*jj_nb,nlev))
    303      CALL histwrite(nid,name,itau,Field3d,iim*jj_nb*nlev,index3d)
     305     ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
     306     ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
     307     CALL histwrite(nid,name,itau,Field3d,nbp_lon*jj_nb*nlev,index3d)
    304308    else
    305309      nlev=size(field,2)
    … …  
    341345                                jj_nb, klon_mpi
    342346  USE xios, only: xios_send_field
    343 
    344 
     347  USE print_control_mod, ONLY: prt_level, lunout
     348  USE mod_grid_phy_lmdz, ONLY: nbp_lon
    345349  IMPLICIT NONE
    346   INCLUDE 'dimensions.h'
    347   INCLUDE 'iniprint.h'
    348350
    349351    CHARACTER(LEN=*), INTENT(IN) :: field_name
    … …  
    351353     
    352354    REAL,DIMENSION(klon_mpi) :: buffer_omp
    353     REAL :: Field2d(iim,jj_nb)
     355    REAL :: Field2d(nbp_lon,jj_nb)
    354356
    355357    IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',trim(field_name)
    356358
    357     IF (SIZE(field)/=klon) CALL abort_gcm('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon',1)
     359    IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon',1)
    358360   
    359361    CALL Gather_omp(field,buffer_omp)   
    … …  
    377379                                jj_nb, klon_mpi
    378380  USE xios, only: xios_send_field
    379 
     381  USE print_control_mod, ONLY: prt_level,lunout
     382  USE mod_grid_phy_lmdz, ONLY: nbp_lon
    380383
    381384  IMPLICIT NONE
    382   INCLUDE 'dimensions.h'
    383   INCLUDE 'iniprint.h'
    384385
    385386    CHARACTER(LEN=*), INTENT(IN) :: field_name
    … …  
    387388
    388389    REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
    389     REAL :: Field3d(iim,jj_nb,SIZE(field,2))
     390    REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
    390391    INTEGER :: ip, n, nlev
    391392
    … …  
    393394
    394395    !Et on.... écrit
    395     IF (SIZE(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
     396    IF (SIZE(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
    396397    nlev=SIZE(field,2)
    397398

  • LMDZ5/branches/testing/libf/phydev/phyaqua_mod.F90

    r1999 r2408  
    88CONTAINS
    99
    10   SUBROUTINE iniaqua(nlon, latfi, lonfi, iflag_phys)
     10  SUBROUTINE iniaqua(nlon, iflag_phys)
    1111
    1212  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    1515  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1616
    17   USE phys_state_var_mod, ONLY: rlat, rlon, phys_state_var_init
     17  USE phys_state_var_mod, ONLY: phys_state_var_init
    1818  USE mod_phys_lmdz_para, ONLY: klon_omp
    19   USE comgeomphy, ONLY: rlond, rlatd
    2019  IMPLICIT NONE
    2120     
    2221  INTEGER,INTENT(IN) :: nlon,iflag_phys
    23   REAL,INTENT(IN) :: lonfi(nlon),latfi(nlon)
    24 
    25   ! local variables
    26   REAL :: pi
    27 
    28   ! initializations:
    29   pi=2.*ASIN(1.)
    3022
    3123  CALL phys_state_var_init()
    32 
    33   rlat(1:klon_omp)=rlatd(1:klon_omp)*180./pi
    34   rlon(1:klon_omp)=rlond(1:klon_omp)*180./pi
    3524
    3625

  • LMDZ5/branches/testing/libf/phydev/phyetat0.F90

    r1910 r2408  
    22! $Id $
    33!
    4 subroutine phyetat0(fichnom)
     4SUBROUTINE phyetat0(fichnom)
    55! Load initial state for the physics
    66! and do some resulting initializations
    77
    8 use iostart, only : open_startphy,get_field,close_startphy
    9 use iophy, only : init_iophy_new
    10 use phys_state_var_mod, only : rlat,rlon
     8  USE dimphy, only: klon
     9  USE iostart, ONLY : open_startphy,get_field,close_startphy
     10  USE iophy, ONLY : init_iophy_new
     11  USE geometry_mod, ONLY : longitude_deg, latitude_deg
    1112
    12 implicit none
     13  IMPLICIT NONE
    1314
    14 character(len=*),intent(in) :: fichnom ! input file name
     15  CHARACTER(len=*),INTENT(in) :: fichnom ! input file name
    1516
    16 ! open physics initial state file:
    17 call open_startphy(fichnom)
     17  REAL :: lon_startphy(klon), lat_startphy(klon)
     18  INTEGER :: i
    1819
    19 ! read latitudes
    20 call get_field("latitude",rlat)
     20  ! open physics initial state file:
     21  CALL open_startphy(fichnom)
    2122
    22 ! read longitudes
    23 call get_field("longitude",rlon)
     23  ! read latitudes and make a sanity check (because already known from dyn)
     24  CALL get_field("latitude",lat_startphy)
     25  DO i=1,klon
     26    IF (ABS(lat_startphy(i)-latitude_deg(i))>=1) THEN
     27      WRITE(*,*) "phyetat0: Error! Latitude discrepancy wrt startphy file:",&
     28                 " i=",i," lat_startphy(i)=",lat_startphy(i),&
     29                 " latitude_deg(i)=",latitude_deg(i)
     30      ! This is presumably serious enough to abort run
     31      CALL abort_physic("phyetat0","discrepancy in latitudes!",1)
     32    ENDIF
     33    IF (ABS(lat_startphy(i)-latitude_deg(i))>=0.0001) THEN
     34      WRITE(*,*) "phyetat0: Warning! Latitude discrepancy wrt startphy file:",&
     35                 " i=",i," lat_startphy(i)=",lat_startphy(i),&
     36                 " latitude_deg(i)=",latitude_deg(i)
     37    ENDIF
     38  ENDDO
    2439
    25 ! read in other variables here ...
     40  ! read longitudes and make a sanity check (because already known from dyn)
     41  CALL get_field("longitude",lon_startphy)
     42  DO i=1,klon
     43    IF (ABS(lon_startphy(i)-longitude_deg(i))>=1) THEN
     44      WRITE(*,*) "phyetat0: Error! Longitude discrepancy wrt startphy file:",&
     45                 " i=",i," lon_startphy(i)=",lon_startphy(i),&
     46                 " longitude_deg(i)=",longitude_deg(i)
     47      ! This is presumably serious enough to abort run
     48      CALL abort_physic("phyetat0","discrepancy in longitudes!",1)
     49    ENDIF
     50    IF (ABS(lon_startphy(i)-longitude_deg(i))>=0.0001) THEN
     51      WRITE(*,*) "phyetat0: Warning! Longitude discrepancy wrt startphy file:",&
     52                 " i=",i," lon_startphy(i)=",lon_startphy(i),&
     53                 " longitude_deg(i)=",longitude_deg(i)
     54    ENDIF
     55  ENDDO
    2656
    27 ! close file
    28 call close_startphy
     57  ! read in other variables here ...
    2958
    30 ! do some more initializations
    31 call init_iophy_new(rlat,rlon)
     59  ! close file
     60  CALL close_startphy
    3261
    33 end subroutine phyetat0
     62  ! do some more initializations
     63  CALL init_iophy_new(latitude_deg,longitude_deg)
     64
     65END SUBROUTINE phyetat0

  • LMDZ5/branches/testing/libf/phydev/phyredem.F90

    r1999 r2408  
    44SUBROUTINE phyredem (fichnom)
    55
     6  USE geometry_mod, ONLY : longitude_deg, latitude_deg
    67  USE iostart, ONLY: open_restartphy, close_restartphy, put_var, put_field
    7   USE phys_state_var_mod, ONLY: rlon, rlat
    88
    99  IMPLICIT NONE
    … …  
    2727  ! coordinates
    2828
    29   CALL put_field("longitude", "Longitudes on physics grid", rlon)
     29  CALL put_field("longitude", "Longitudes on physics grid", longitude_deg)
    3030     
    31   CALL put_field("latitude", "Latitudes on physics grid", rlat)
     31  CALL put_field("latitude", "Latitudes on physics grid", latitude_deg)
    3232
    3333  ! close file

  • LMDZ5/branches/testing/libf/phydev/phys_state_var_mod.F90

    r1910 r2408  
    77!======================================================================
    88
    9 USE dimphy, only : klon
     9!USE dimphy, only : klon
    1010 
    1111
    12 REAL, ALLOCATABLE, SAVE :: rlat(:), rlon(:)
    13 !$OMP THREADPRIVATE(rlat,rlon)
     12!REAL, ALLOCATABLE, SAVE :: rlat(:), rlon(:)
     13!!$OMP THREADPRIVATE(rlat,rlon)
    1414
    1515CONTAINS
    … …  
    1717!======================================================================
    1818  SUBROUTINE phys_state_var_init()
    19   use dimphy, only : klon
     19!  use dimphy, only : klon
    2020
    21   if (.not.allocated(rlat)) then
    22     ALLOCATE(rlat(klon),rlon(klon))
    23   else
    24     write(*,*) "phys_state_var_init: warning, rlat already allocated"
    25   endif
     21!  if (.not.allocated(rlat)) then
     22!    ALLOCATE(rlat(klon),rlon(klon))
     23!  else
     24!    write(*,*) "phys_state_var_init: warning, rlat already allocated"
     25!  endif
    2626 
    2727  END SUBROUTINE phys_state_var_init
    … …  
    2929!======================================================================
    3030  SUBROUTINE phys_state_var_end
    31   use dimphy, only : klon
     31!  use dimphy, only : klon
    3232
    33   deallocate(rlat,rlon)
     33!  deallocate(rlat,rlon)
    3434
    3535  END SUBROUTINE phys_state_var_end

  • LMDZ5/branches/testing/libf/phydev/physiq.F90

    r2258 r2408  
    55     &            debut,lafin,jD_cur, jH_cur,pdtphys, &
    66     &            paprs,pplay,pphi,pphis,presnivs, &
    7      &            u,v,t,qx, &
     7     &            u,v,rot,t,qx, &
    88     &            flxmass_w, &
    99     &            d_u, d_v, d_t, d_qx, d_ps &
    … …  
    1111
    1212      USE dimphy, only : klon,klev
    13       USE infotrac, only : nqtot
    14       USE comgeomphy, only : rlatd
     13      USE infotrac_phy, only : nqtot
     14      USE geometry_mod, only : latitude
    1515      USE comcstphy, only : rg
    1616      USE iophy, only : histbeg_phy,histwrite_phy
    … …  
    1818      USE mod_phys_lmdz_para, only : jj_nb
    1919      USE phys_state_var_mod, only : phys_state_var_init
     20      USE mod_grid_phy_lmdz, ONLY: nbp_lon,nbp_lat
    2021
    2122#ifdef CPP_XIOS
    … …  
    2627
    2728      IMPLICIT none
    28 #include "dimensions.h"
    29 
    30       integer,parameter :: jjmp1=jjm+1-1/jjm
    31       integer,parameter :: iip1=iim+1
    3229!
    3330! Routine argument:
    … …  
    5552      real,intent(out) :: d_qx(klon,klev,nqtot) ! physics tendency on tracers
    5653      real,intent(out) :: d_ps(klon) ! physics tendency on surface pressure
    57       real,intent(in) :: dudyn(iim+1,jjmp1,klev) ! Not used
     54      real,intent(in) :: dudyn(nbp_lon+1,nbp_lat,klev) ! Not used
     55      REAL, intent(in):: rot(klon, klev) ! Not used
     56      ! relative vorticity, in s-1, needed for frontal waves
    5857
    5958integer,save :: itau=0 ! counter to count number of calls to physics
    … …  
    114113  ! define variables which will be written in "histins.nc" file
    115114  call histdef(nid_hist,'temperature','Atmospheric temperature','K', &
    116                iim,jj_nb,nhori,klev,1,klev,zvertid,32, &
     115               nbp_lon,jj_nb,nhori,klev,1,klev,zvertid,32, &
    117116               'inst(X)',t_ops,t_wrt)
    118117  call histdef(nid_hist,'u','Eastward Zonal Wind','m/s', &
    119                iim,jj_nb,nhori,klev,1,klev,zvertid,32, &
     118               nbp_lon,jj_nb,nhori,klev,1,klev,zvertid,32, &
    120119               'inst(X)',t_ops,t_wrt)
    121120  call histdef(nid_hist,'v','Northward Meridional Wind','m/s', &
    122                iim,jj_nb,nhori,klev,1,klev,zvertid,32, &
     121               nbp_lon,jj_nb,nhori,klev,1,klev,zvertid,32, &
    123122               'inst(X)',t_ops,t_wrt)
    124123  call histdef(nid_hist,'ps','Surface Pressure','Pa', &
    125                iim,jj_nb,nhori,1,1,1,zvertid,32, &
     124               nbp_lon,jj_nb,nhori,1,1,1,zvertid,32, &
    126125               'inst(X)',t_ops,t_wrt)
    127126  ! end definition sequence
    … …  
    160159! newtonian relaxation towards temp_newton()
    161160do k=1,klev
    162   temp_newton(1:klon,k)=280.+cos(rlatd(1:klon))*40.-pphi(1:klon,k)/rg*6.e-3
     161  temp_newton(1:klon,k)=280.+cos(latitude(1:klon))*40.-pphi(1:klon,k)/rg*6.e-3
    163162  d_t(1:klon,k)=(temp_newton(1:klon,k)-t(1:klon,k))/1.e5
    164163enddo
Note: See TracChangeset for help on using the changeset viewer.