Ignore:
Timestamp:
Jul 18, 2013, 3:32:27 PM (11 years ago)
Author:
Ehouarn Millour
Message:

Déplacement de nombreuses variables de physiq.F vers phys_local_var_mod.
UG
................................
Moving of numerous vars from physiq.F to phys_local_var_mod.
UG

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ5/trunk/libf/phylmd/iophy.F90

    r1791 r1797  
    44module iophy
    55 
    6 ! abd  REAL,private,allocatable,dimension(:),save :: io_lat
    7 ! abd  REAL,private,allocatable,dimension(:),save :: io_lon
     6! abd  REAL,private,allocatable,DIMENSION(:),save :: io_lat
     7! abd  REAL,private,allocatable,DIMENSION(:),save :: io_lon
    88  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lat
    99  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lon
     
    2424
    2525
    26 contains
    27 
    28   subroutine init_iophy_new(rlat,rlon)
     26CONTAINS
     27
     28! ug Routine pour définir itau_iophy depuis phys_output_write_mod:
     29  SUBROUTINE set_itau_iophy(ito)
     30      IMPLICIT NONE
     31      INTEGER, INTENT(IN) :: ito
     32      itau_iophy = ito
     33  END SUBROUTINE
     34
     35  SUBROUTINE init_iophy_new(rlat,rlon)
    2936  USE dimphy
    3037  USE mod_phys_lmdz_para
    3138  USE mod_grid_phy_lmdz
    3239  USE ioipsl
    33   implicit none
    34   include 'dimensions.h'   
    35     real,dimension(klon),intent(in) :: rlon
    36     real,dimension(klon),intent(in) :: rlat
    37 
    38     REAL,dimension(klon_glo)        :: rlat_glo
    39     REAL,dimension(klon_glo)        :: rlon_glo
     40  IMPLICIT NONE
     41  INCLUDE 'dimensions.h'   
     42    REAL,DIMENSION(klon),INTENT(IN) :: rlon
     43    REAL,DIMENSION(klon),INTENT(IN) :: rlat
     44
     45    REAL,DIMENSION(klon_glo)        :: rlat_glo
     46    REAL,DIMENSION(klon_glo)        :: rlon_glo
    4047   
    4148    INTEGER,DIMENSION(2) :: ddid
     
    7279    dpl=(/ iim, jj_end /)
    7380    dhs=(/ ii_begin-1,0 /)
    74     if (mpi_rank==mpi_size-1) then
     81    IF (mpi_rank==mpi_size-1) THEN
    7582      dhe=(/0,0/)
    76     else
     83    ELSE
    7784      dhe=(/ iim-ii_end,0 /) 
    78     endif
    79    
    80     call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
     85    ENDIF
     86   
     87    CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
    8188                      'APPLE',phys_domain_id)
    8289
    8390!$OMP END MASTER
    8491     
    85   end subroutine init_iophy_new
    86 
    87   subroutine init_iophy(lat,lon)
    88   USE dimphy
    89   USE mod_phys_lmdz_para
    90   use ioipsl
    91   implicit none
    92   include 'dimensions.h'   
    93     real,dimension(iim),intent(in) :: lon
    94     real,dimension(jjm+1-1/(iim*jjm)),intent(in) :: lat
     92  END SUBROUTINE init_iophy_new
     93
     94  SUBROUTINE init_iophy(lat,lon)
     95  USE dimphy
     96  USE mod_phys_lmdz_para
     97  USE ioipsl
     98  IMPLICIT NONE
     99  INCLUDE 'dimensions.h'   
     100    REAL,DIMENSION(iim),INTENT(IN) :: lon
     101    REAL,DIMENSION(jjm+1-1/(iim*jjm)),INTENT(IN) :: lat
    95102
    96103    INTEGER,DIMENSION(2) :: ddid
     
    125132!$OMP END MASTER
    126133     
    127   end subroutine init_iophy
    128  
    129   subroutine histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
     134  end SUBROUTINE init_iophy
     135 
     136  SUBROUTINE histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
    130137  USE dimphy
    131138  USE mod_phys_lmdz_para
    132139  use ioipsl
    133140  use write_field
    134   implicit none
     141  IMPLICIT NONE
    135142  include 'dimensions.h'
    136143   
    137     character*(*), intent(IN) :: name
    138     integer, intent(in) :: itau0
    139     real,intent(in) :: zjulian
    140     real,intent(in) :: dtime
     144    character*(*), INTENT(IN) :: name
     145    integer, INTENT(IN) :: itau0
     146    REAL,INTENT(IN) :: zjulian
     147    REAL,INTENT(IN) :: dtime
    141148    integer,intent(out) :: nhori
    142149    integer,intent(out) :: nid_day
     
    152159!$OMP END MASTER
    153160 
    154   end subroutine histbeg_phy
    155 
    156   subroutine histbeg_phy_points(rlon,rlat,pim,tabij,ipt,jpt, &
     161  END SUBROUTINE histbeg_phy
     162
     163  SUBROUTINE histbeg_phy_points(rlon,rlat,pim,tabij,ipt,jpt, &
    157164             plon,plat,plon_bounds,plat_bounds, &
    158165             nname,itau0,zjulian,dtime,nnhori,nnid_day)
     
    162169  use ioipsl
    163170  use write_field
    164   implicit none
     171  IMPLICIT NONE
    165172  include 'dimensions.h'
    166173
    167     real,dimension(klon),intent(in) :: rlon
    168     real,dimension(klon),intent(in) :: rlat
    169     integer, intent(in) :: itau0
    170     real,intent(in) :: zjulian
    171     real,intent(in) :: dtime
    172     integer, intent(in) :: pim
     174    REAL,DIMENSION(klon),INTENT(IN) :: rlon
     175    REAL,DIMENSION(klon),INTENT(IN) :: rlat
     176    integer, INTENT(IN) :: itau0
     177    REAL,INTENT(IN) :: zjulian
     178    REAL,INTENT(IN) :: dtime
     179    integer, INTENT(IN) :: pim
    173180    integer, intent(out) :: nnhori
    174     character(len=20), intent(in) :: nname
     181    character(len=20), INTENT(IN) :: nname
    175182    INTEGER, intent(out) :: nnid_day
    176183    integer :: i
    177     REAL,dimension(klon_glo)        :: rlat_glo
    178     REAL,dimension(klon_glo)        :: rlon_glo
    179     INTEGER, DIMENSION(pim), intent(in)  :: tabij
    180     REAL,dimension(pim), intent(in) :: plat, plon
    181     INTEGER,dimension(pim), intent(in) :: ipt, jpt
    182     REAL,dimension(pim,2), intent(out) :: plat_bounds, plon_bounds
     184    REAL,DIMENSION(klon_glo)        :: rlat_glo
     185    REAL,DIMENSION(klon_glo)        :: rlon_glo
     186    INTEGER, DIMENSION(pim), INTENT(IN)  :: tabij
     187    REAL,DIMENSION(pim), INTENT(IN) :: plat, plon
     188    INTEGER,DIMENSION(pim), INTENT(IN) :: ipt, jpt
     189    REAL,DIMENSION(pim,2), intent(out) :: plat_bounds, plon_bounds
    183190
    184191    INTEGER, SAVE :: tabprocbeg, tabprocend
     
    187194    INTEGER, PARAMETER :: nip=1
    188195    INTEGER :: npproc
    189     REAL, allocatable, dimension(:) :: npplat, npplon
    190     REAL, allocatable, dimension(:,:) :: npplat_bounds, npplon_bounds
     196    REAL, allocatable, DIMENSION(:) :: npplat, npplon
     197    REAL, allocatable, DIMENSION(:,:) :: npplat_bounds, npplon_bounds
    191198    INTEGER, PARAMETER :: jjmp1=jjm+1-1/jjm
    192     REAL, dimension(iim,jjmp1) :: zx_lon, zx_lat
     199    REAL, DIMENSION(iim,jjmp1) :: zx_lon, zx_lat
    193200
    194201    CALL gather(rlat,rlat_glo)
     
    323330!$OMP END MASTER
    324331
    325   end subroutine histbeg_phy_points
     332  end SUBROUTINE histbeg_phy_points
    326333 
    327334  SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
     
    334341  include 'iniprint.h'
    335342   
    336     integer,intent(in) :: nid
    337     logical,intent(in) :: lpoint
    338     character*(*), intent(IN) :: name
    339     integer, intent(in) :: itau
    340     real,dimension(:),intent(in) :: field
    341     REAL,dimension(klon_mpi) :: buffer_omp
    342     INTEGER, allocatable, dimension(:) :: index2d
     343    integer,INTENT(IN) :: nid
     344    logical,INTENT(IN) :: lpoint
     345    character*(*), INTENT(IN) :: name
     346    integer, INTENT(IN) :: itau
     347    REAL,DIMENSION(:),INTENT(IN) :: field
     348    REAL,DIMENSION(klon_mpi) :: buffer_omp
     349    INTEGER, allocatable, DIMENSION(:) :: index2d
    343350    REAL :: Field2d(iim,jj_nb)
    344351
    345352    integer :: ip
    346     real,allocatable,dimension(:) :: fieldok
    347 
    348 
    349     IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first dimension not equal to klon',1)
     353    REAL,allocatable,DIMENSION(:) :: fieldok
     354
     355
     356    IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first DIMENSION not equal to klon',1)
    350357   
    351358    CALL Gather_omp(field,buffer_omp)   
     
    387394
    388395 
    389   end subroutine histwrite2d_phy_old
    390 
    391   subroutine histwrite3d_phy_old(nid,lpoint,name,itau,field)
     396  end SUBROUTINE histwrite2d_phy_old
     397
     398  SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field)
    392399  USE dimphy
    393400  USE mod_phys_lmdz_para
     
    395402
    396403  use ioipsl
    397   implicit none
     404  IMPLICIT NONE
    398405  include 'dimensions.h'
    399406  include 'iniprint.h'
    400407   
    401     integer,intent(in) :: nid
    402     logical,intent(in) :: lpoint
    403     character*(*), intent(IN) :: name
    404     integer, intent(in) :: itau
    405     real,dimension(:,:),intent(in) :: field  ! --> field(klon,:)
    406     REAL,dimension(klon_mpi,size(field,2)) :: buffer_omp
     408    integer,INTENT(IN) :: nid
     409    logical,INTENT(IN) :: lpoint
     410    character*(*), INTENT(IN) :: name
     411    integer, INTENT(IN) :: itau
     412    REAL,DIMENSION(:,:),INTENT(IN) :: field  ! --> field(klon,:)
     413    REAL,DIMENSION(klon_mpi,size(field,2)) :: buffer_omp
    407414    REAL :: Field3d(iim,jj_nb,size(field,2))
    408415    INTEGER :: ip, n, nlev
    409     INTEGER, ALLOCATABLE, dimension(:) :: index3d
    410     real,allocatable, dimension(:,:) :: fieldok
    411 
    412 
    413     IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first dimension not equal to klon',1)
     416    INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
     417    REAL,allocatable, DIMENSION(:,:) :: fieldok
     418
     419
     420    IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
    414421    nlev=size(field,2)
    415422
     
    460467!$OMP END MASTER   
    461468
    462   end subroutine histwrite3d_phy_old
     469  end SUBROUTINE histwrite3d_phy_old
    463470
    464471
     
    480487  include 'dimensions.h'
    481488   
    482 !    integer,intent(in) :: nid
    483 !    logical,intent(in) :: lpoint
    484 !    character*(*), intent(IN) :: name
    485 !    integer, intent(in) :: itau
    486 !    real,dimension(:),intent(in) :: field
     489!    integer,INTENT(IN) :: nid
     490!    logical,INTENT(IN) :: lpoint
     491!    character*(*), INTENT(IN) :: name
     492!    integer, INTENT(IN) :: itau
     493!    REAL,DIMENSION(:),INTENT(IN) :: field
    487494
    488495      TYPE(ctrl_out), INTENT(IN) :: var
     
    492499      INTEGER :: iff, iff_beg, iff_end
    493500     
    494     REAL,dimension(klon_mpi) :: buffer_omp
    495     INTEGER, allocatable, dimension(:) :: index2d
     501    REAL,DIMENSION(klon_mpi) :: buffer_omp
     502    INTEGER, allocatable, DIMENSION(:) :: index2d
    496503    REAL :: Field2d(iim,jj_nb)
    497504
     
    508515      END IF
    509516
    510     IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first dimension not equal to klon',1)
     517    IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first DIMENSION not equal to klon',1)
    511518   
    512519    CALL Gather_omp(field,buffer_omp)   
     
    578585  include 'dimensions.h'
    579586   
    580 !    integer,intent(in) :: nid
    581 !    logical,intent(in) :: lpoint
    582 !    character*(*), intent(IN) :: name
    583 !    integer, intent(in) :: itau
    584 !    real,dimension(:,:),intent(in) :: field  ! --> field(klon,:)
     587!    integer,INTENT(IN) :: nid
     588!    logical,INTENT(IN) :: lpoint
     589!    character*(*), INTENT(IN) :: name
     590!    integer, INTENT(IN) :: itau
     591!    REAL,DIMENSION(:,:),INTENT(IN) :: field  ! --> field(klon,:)
    585592
    586593      TYPE(ctrl_out), INTENT(IN) :: var
     
    594601    REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
    595602
    596     IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first dimension not equal to klon',1)
     603    IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
    597604    nlev=size(field,2)
    598605
Note: See TracChangeset for help on using the changeset viewer.