Changeset 912


Ignore:
Timestamp:
06/17/19 12:13:33 (5 years ago)
Author:
dubos
Message:

devel : cosmetic changes to comply with XCodeML

Location:
codes/icosagcm/devel/src
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/devel/src/diagnostics/compute_rhodz.F90

    r906 r912  
    1313 
    1414CONTAINS 
    15  
    16   SUBROUTINE check_interface 
    17     USE compute_diagnostics_mod 
    18     compute_rhodz => compute_rhodz_hex 
    19     compute_rhodz => compute_rhodz_unst 
    20   END SUBROUTINE check_interface 
    2115 
    2216#if BEGIN_DYSL 
    … …  
    117111  END SUBROUTINE compute_rhodz_handmade 
    118112  
    119  
    120113END MODULE compute_rhodz_mod 

  • codes/icosagcm/devel/src/dynamics/caldyn.f90

    r572 r912  
    11MODULE caldyn_mod 
    22  USE icosa 
     3  IMPLICIT NONE 
    34  PRIVATE 
    45  SAVE 
    5   CHARACTER(LEN=255),SAVE :: caldyn_type 
     6  CHARACTER(LEN=255) :: caldyn_type 
    67!$OMP THREADPRIVATE(caldyn_type) 
    78  
    8   PUBLIC init_caldyn, caldyn, caldyn_BC, dysl 
     9  PUBLIC init_caldyn, caldyn, caldyn_BC 
    910   
    1011CONTAINS 
    1112 
    1213  SUBROUTINE init_caldyn 
    13   USE icosa 
    14   USE caldyn_gcm_mod, ONLY : init_caldyn_gcm=>init_caldyn 
    15   USE caldyn_adv_mod, ONLY : init_caldyn_adv=>init_caldyn 
    16   IMPLICIT NONE 
     14    USE caldyn_gcm_mod, ONLY : init_caldyn_gcm=>init_caldyn 
     15    USE caldyn_adv_mod, ONLY : init_caldyn_adv=>init_caldyn 
    1716   
    1817    caldyn_type="gcm" 

  • codes/icosagcm/devel/src/dynamics/compute_pvort_only.F90

    r884 r912  
    1010CONTAINS 
    1111 
    12   SUBROUTINE check_interface 
    13     USE compute_caldyn_mod 
    14     compute_pvort_only => compute_pvort_only_unst 
    15     compute_pvort_only => compute_pvort_only_hex 
    16   END SUBROUTINE check_interface 
    17    
    1812#if BEGIN_DYSL 
    1913 

  • codes/icosagcm/devel/src/output/restart.f90

    r533 r912  
    11MODULE restart_mod 
     2  USE prec, ONLY : rstd 
    23  USE field_mod 
     4  USE domain_mod 
     5  USE xios_mod 
     6  USE netcdf_mod 
     7  USE omp_para, ONLY : is_omp_master 
     8  USE mpipara, ONLY : is_mpi_master, is_mpi_root 
     9  USE time_mod, ONLY : itaumax 
     10  USE metric, ONLY : ncell_glo, cell_glo 
     11  USE getin_mod, ONLY : getin 
     12  USE spherical_geom_mod, ONLY : xyz2lonlat 
     13  USE transfert_mod, ONLY : gather_field, scatter_field 
     14  IMPLICIT NONE 
     15  PRIVATE 
    316 
    417  TYPE t_field_array 
    … …  
    821  LOGICAL,SAVE :: write_start=.TRUE. 
    922 
     23  PUBLIC :: write_start, init_restart, write_restart, read_start 
     24 
    1025CONTAINS 
    1126   
    1227  SUBROUTINE init_restart 
    13   USE xios_mod 
    14   USE icosa 
    15   USE time_mod 
    16   USE omp_para 
    17   IMPLICIT NONE 
    1828  CHARACTER(LEN=255) :: start_file_name 
    1929  CHARACTER(LEN=255) :: restart_file_name 
    … …  
    3747  SUBROUTINE write_restart(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9,   & 
    3848                           field10,field11,field12,field13,field14,field15,field16,field17,field18,field19 ) 
    39   USE prec 
    40   USE metric 
    41   USE field_mod 
    42   USE domain_mod 
    43   USE netcdf_mod 
    44   USE mpipara 
    45   USE omp_para 
    46   USE getin_mod 
    47   USE spherical_geom_mod 
    48   USE transfert_mod 
    49   USE disvert_mod 
    50   USE xios_mod 
    51   IMPLICIT NONE  
    52   INTEGER,INTENT(IN)     :: it 
     49    USE disvert_mod, ONLY : presnivs 
     50 
     51    INTEGER,INTENT(IN)     :: it 
    5352 
    5453  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9 
    … …  
    233232   
    234233  SUBROUTINE write_restart_field(field,fieldId,ncid) 
    235   USE prec 
    236   USE metric 
    237   USE field_mod 
    238   USE domain_mod 
    239   USE netcdf_mod 
    240   USE mpipara 
    241   USE getin_mod 
    242   USE spherical_geom_mod 
    243   USE transfert_mod 
    244   USE xios_mod 
    245   IMPLICIT NONE 
    246234    TYPE(t_field),POINTER :: field(:) 
    247235    INTEGER,INTENT(IN)     :: fieldId 
    … …  
    398386  SUBROUTINE read_start(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9,   & 
    399387                           field10,field11,field12,field13,field14,field15,field16,field17,field18,field19 ) 
    400   USE prec 
    401   USE metric 
    402   USE field_mod 
    403   USE domain_mod 
    404   USE netcdf_mod 
    405   USE mpipara 
    406   USE getin_mod 
    407   USE spherical_geom_mod 
    408   USE transfert_mod 
    409   USE xios_mod 
    410388  
    411   IMPLICIT NONE 
    412389  INTEGER, INTENT(OUT)  :: it 
    413390  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9 
    … …  
    514491 
    515492  SUBROUTINE read_start_field(field,fieldId,ncid) 
    516   USE prec 
    517   USE metric 
    518   USE field_mod 
    519   USE domain_mod 
    520   USE netcdf_mod 
    521   USE mpipara 
    522   USE getin_mod 
    523   USE spherical_geom_mod 
    524   USE transfert_mod 
    525   IMPLICIT NONE 
    526493    TYPE(t_field),POINTER :: field(:) 
    527494    INTEGER,INTENT(IN)     :: fieldId 

  • codes/icosagcm/devel/src/vertical/disvert_dcmip200.f90

    r531 r912  
    11  MODULE disvert_dcmip200_mod 
    2   USE icosa 
    3   
     2    USE prec, ONLY : rstd 
     3    USE grid_param, ONLY : llm 
     4 
     5  IMPLICIT NONE 
     6  PRIVATE 
     7 
    48  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: ap(:) 
    59!$OMP THREADPRIVATE(ap) 
    … …  
    913!$OMP THREADPRIVATE(presnivs) 
    1014 
     15  PUBLIC :: init_disvert, ap, bp, presnivs 
     16 
    1117CONTAINS 
    1218!========================================================================= 
    1319 
    1420  SUBROUTINE init_disvert 
    15   USE icosa 
    16   USE mpipara 
    17   IMPLICIT NONE 
    18    
     21    USE mpipara 
     22     
    1923    ALLOCATE(ap(llm+1)) 
    2024    ALLOCATE(bp(llm+1)) 
    … …  
    2226     
    2327    CALL disvert(ap,bp,presnivs)     
    24  
    25   END SUBROUTINE init_disvert   
     28     
     29  END SUBROUTINE init_disvert 
    2630 
    2731  SUBROUTINE disvert(ap,bp,presnivs) 
    28   USE icosa 
    29   USE mpipara 
    30   IMPLICIT NONE 
    31   REAL(rstd),INTENT(OUT) :: ap(:) 
    32   REAL(rstd),INTENT(OUT) :: bp(:) 
    33   REAL(rstd),INTENT(OUT) :: presnivs(:) 
    34   ! reads from run.def : ncar_dz, ncar_T0, ncar_p0, ncar_disvert_c 
    35   INTEGER :: l,cindx 
    36   REAL(rstd) ::  eta_top, eta 
    37   REAL(rstd),PARAMETER :: N=0.01         ! Brunt-Vaisala frequency (s-1) 
    38   REAL(rstd),PARAMETER :: T0=300.       ! Surface temperature at the equator (K) 
    39   REAL(rstd) :: Rd        
    40   REAL(rstd), PARAMETER :: Gamma=0.0065        
    41  
    42   Rd=cpp*kappa 
    43   ncar_dz=400 ; CALL getin('ncar_dz',ncar_dz); 
    44   cindx=1 ; CALL getin('ncar_disvert_c',cindx) 
    45  
     32    USE earth_const, ONLY : cpp, kappa, preff, g 
     33    USE icosa, ONLY       : ncar_dz, ncar_T0, ncar_p0 
     34    USE getin_mod, ONLY   : getin 
     35    USE mpipara, ONLY     : is_mpi_root 
     36    REAL(rstd),INTENT(OUT) :: ap(:) 
     37    REAL(rstd),INTENT(OUT) :: bp(:) 
     38    REAL(rstd),INTENT(OUT) :: presnivs(:) 
     39    ! reads from run.def : ncar_dz, ncar_T0, ncar_p0, ncar_disvert_c 
     40    INTEGER :: l,cindx 
     41    REAL(rstd) ::  eta_top, eta 
     42    REAL(rstd),PARAMETER :: N=0.01         ! Brunt-Vaisala frequency (s-1) 
     43    REAL(rstd),PARAMETER :: T0=300.       ! Surface temperature at the equator (K) 
     44    REAL(rstd) :: Rd        
     45    REAL(rstd), PARAMETER :: Gamma=0.0065        
     46     
     47    Rd=cpp*kappa 
     48    ncar_dz=400 ; CALL getin('ncar_dz',ncar_dz); 
     49    cindx=1 ; CALL getin('ncar_disvert_c',cindx)   
     50     
     51    eta_top = (1-Gamma/T0*llm*ncar_dz)**(g/(Rd*Gamma))   
     52    do l = 1,llm+1 
     53       eta = (1-Gamma/T0*(l-1)*ncar_dz)**(g/(Rd*Gamma)) 
     54       PRINT *,'eta ->', eta 
     55       bp(l) = ((eta - eta_top)/(1 - eta_top))**cindx 
     56       ap(l) = preff * ( eta - bp(l) ) 
     57    ENDDO 
     58    bp(1)=1. 
     59    ap(1)=0. 
     60    bp(llm+1) = 0 
     61     
     62    DO l = 1, llm 
     63       presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff ) 
     64    ENDDO 
     65     
     66    !$OMP MASTER   
     67    IF (is_mpi_root) PRINT *, 'Vertical placement of model levels according to DCMIP Appendix E.3' 
     68    IF (is_mpi_root) PRINT *, 'Parameters : ncar_dz=', ncar_dz, '  ncar_p0=',ncar_p0, '  ncar_disvert_c=',cindx 
     69    IF (is_mpi_root) PRINT *, 'Isothermal amtosphere with ncar_T0=',ncar_T0  
     70    !$OMP END MASTER   
     71     
     72  END SUBROUTINE disvert 
    4673   
    47      
    48   eta_top = (1-Gamma/T0*llm*ncar_dz)**(g/(Rd*Gamma))   
    49   do l = 1,llm+1 
    50      eta = (1-Gamma/T0*(l-1)*ncar_dz)**(g/(Rd*Gamma)) 
    51      PRINT *,'eta ->', eta 
    52      bp(l) = ((eta - eta_top)/(1 - eta_top))**cindx 
    53      ap(l) = preff * ( eta - bp(l) ) 
    54   ENDDO 
    55   bp(1)=1. 
    56   ap(1)=0. 
    57   bp(llm+1) = 0 
    58    
    59   DO l = 1, llm 
    60      presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff ) 
    61   ENDDO 
    62  
    63 !$OMP MASTER   
    64   IF (is_mpi_root) PRINT *, 'Vertical placement of model levels according to DCMIP Appendix E.3' 
    65   IF (is_mpi_root) PRINT *, 'Parameters : ncar_dz=', ncar_dz, '  ncar_p0=',ncar_p0, '  ncar_disvert_c=',cindx 
    66   IF (is_mpi_root) PRINT *, 'Isothermal amtosphere with ncar_T0=',ncar_T0  
    67 !$OMP END MASTER   
    68  
    69 END SUBROUTINE disvert 
    70  
    7174END  MODULE disvert_dcmip200_mod 
Note: See TracChangeset for help on using the changeset viewer.