Changeset 461


Ignore:
Timestamp:
2011-09-08T09:37:26+02:00 (13 years ago)
Author:
didier.solyga
Message:

Correct bcast functions. In sechiba modules, move var_name from save variables to local variables. Correct a save attribute to parameter attribute in constantes_mtc.f90

Location:
branches/ORCHIDEE_EXT/ORCHIDEE
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • branches/ORCHIDEE_EXT/ORCHIDEE/src_parallel/transfert_para.f90

    r435 r461  
    6565!! -- Les chaine de charactère -- !! 
    6666 
    67   SUBROUTINE bcast_c(var1) 
     67  SUBROUTINE bcast_c(var) 
    6868  IMPLICIT NONE 
    69     CHARACTER(LEN=*),INTENT(INOUT) :: Var1 
     69    CHARACTER(LEN=*),INTENT(INOUT) :: Var 
     70    CHARACTER(LEN=100),DIMENSION(1) :: Var1 
     71#ifndef CPP_PARA 
     72    RETURN 
     73#else 
     74    IF (is_root_prc) & 
     75         Var1(1)=Var 
     76    CALL bcast_cgen(Var1,1) 
     77    Var=Var1(1) 
     78#endif 
     79  END SUBROUTINE bcast_c 
     80 
     81!>>ADD_DS 02/09/2011 : add for vector of characters 
     82 
     83  SUBROUTINE bcast_c1(var) 
     84  IMPLICIT NONE 
     85    CHARACTER(LEN=*),INTENT(INOUT) :: Var(:) 
    7086    
    7187#ifndef CPP_PARA 
    7288    RETURN 
    7389#else 
    74     CALL bcast_cgen(Var1,len(Var1)) 
    75 #endif 
    76   END SUBROUTINE bcast_c 
    77  
    78 ! DS 02/09/2011 : add for vector of characters 
    79  
    80   SUBROUTINE bcast_c1(var1) 
     90    CALL bcast_cgen(Var,size(Var)) 
     91#endif 
     92  END SUBROUTINE bcast_c1 
     93 
     94 
     95!! -- Les entiers -- !! 
     96 
     97!>> Modif DS 08/09/2011   
     98  SUBROUTINE bcast_i(var) 
    8199  IMPLICIT NONE 
    82     CHARACTER(LEN=*),INTENT(INOUT) :: Var1(:) 
    83     
    84 #ifndef CPP_PARA 
    85     RETURN 
    86 #else 
    87     CALL bcast_cgen(Var1,size(Var1)) 
    88 #endif 
    89   END SUBROUTINE bcast_c1 
    90  
    91 !! -- Les entiers -- !! 
    92    
    93   SUBROUTINE bcast_i(var1) 
    94   IMPLICIT NONE 
    95     INTEGER,INTENT(INOUT) :: Var1 
    96     
    97 #ifndef CPP_PARA 
    98     RETURN 
    99 #else 
     100    INTEGER,INTENT(INOUT) :: Var 
     101    INTEGER,DIMENSION(1) :: Var1 
     102 
     103#ifndef CPP_PARA 
     104    RETURN 
     105#else 
     106   IF (is_root_prc) & 
     107         Var1(1)=Var  
    100108    CALL bcast_igen(Var1,1) 
     109    Var=Var1(1) 
    101110#endif 
    102111  END SUBROUTINE bcast_i 
     112!>> Modif DS 08/09/2011  
    103113 
    104114  SUBROUTINE bcast_i1(var) 
    … …  
    149159!! -- Les reels -- !! 
    150160 
     161!>> Modif DS 08/09/2011   
    151162  SUBROUTINE bcast_r(var) 
    152163  IMPLICIT NONE 
    153164    REAL,INTENT(INOUT) :: Var 
    154     
    155 #ifndef CPP_PARA 
    156     RETURN 
    157 #else 
    158     CALL bcast_rgen(Var,1) 
     165    REAL,DIMENSION(1) :: Var1    
     166#ifndef CPP_PARA 
     167    RETURN 
     168#else 
     169    IF (is_root_prc) & 
     170         Var1(1)=Var 
     171    CALL bcast_rgen(Var1,1) 
     172    Var=Var1(1) 
    159173#endif 
    160174  END SUBROUTINE bcast_r 
     175!>> Modif DS 08/09/2011  
    161176 
    162177  SUBROUTINE bcast_r1(var) 
    … …  
    19681983    IMPLICIT NONE 
    19691984     
    1970     CHARACTER(LEN=*),INTENT(INOUT) :: Var 
     1985    CHARACTER(LEN=*),DIMENSION(nb),INTENT(INOUT) :: Var 
    19711986    INTEGER,INTENT(IN) :: nb 
    19721987     
    … …  
    19992014    IMPLICIT NONE 
    20002015     
    2001     INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var 
     2016    INTEGER,DIMENSION(nb),INTENT(INOUT) :: var 
    20022017    INTEGER,INTENT(IN) :: nb 
    20032018     
    … …  
    20312046    IMPLICIT NONE 
    20322047     
    2033     REAL,DIMENSION(nb),INTENT(INOUT) :: Var 
     2048    REAL,DIMENSION(nb),INTENT(INOUT) :: var 
    20342049    INTEGER,INTENT(IN) :: nb 
    20352050     

  • branches/ORCHIDEE_EXT/ORCHIDEE/src_parameters/constantes_mtc.f90

    r325 r461  
    2121 
    2222  ! description of the MTC 
    23   CHARACTER(len=34), SAVE, DIMENSION(nvmc)              :: MTC_name = & 
     23  CHARACTER(len=34), PARAMETER, DIMENSION(nvmc)              :: MTC_name = & 
    2424  & (/ 'bared ground                      ', &          !  1 
    2525  &    'tropical  broad-leaved evergreen  ', &          !  2 

  • branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/diffuco.f90

    r282 r461  
    3434  ! 
    3535  LOGICAL, SAVE                                     :: l_first_diffuco = .TRUE.  !! Initialisation has to be done one time 
    36   CHARACTER(LEN=80)                                 :: var_name                  !! To store variables names for I/O 
    3736  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: leaf_ci                   !! intercellular CO2 concentration (ppm) 
    3837  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: rstruct                   !! architectural resistance 
    … …  
    138137    INTEGER(i_std)                                    :: ilai 
    139138    CHARACTER(LEN=4)                                  :: laistring 
     139    CHARACTER(LEN=80)                                 :: var_name                  !! To store variables names for I/O 
    140140 
    141141    ! do initialisation if needed 
    … …  
    329329    CHARACTER(LEN=4)                :: laistring 
    330330    REAL(r_std),DIMENSION (kjpindex)   :: temp 
    331  
     331    CHARACTER(LEN=80)                  :: var_name                  !! To store variables names for I/O 
    332332    ! 
    333333    ! initialisation 

  • branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/enerbil.f90

    r257 r461  
    3737  ! 
    3838  LOGICAL, SAVE                              :: l_first_enerbil=.TRUE.  !! Initialisation has to be done one time 
    39  
    40   CHARACTER(LEN=80), SAVE                    :: var_name                !! To store variables names for I/O 
    4139 
    4240  ! one dimension array allocated, computed and used in enerbil module exclusively 
    … …  
    142140    ! 
    143141    REAL(r_std),DIMENSION (kjpindex) :: epot_air_new, qair_new 
     142    CHARACTER(LEN=80)                :: var_name                !! To store variables names for I/O 
    144143    ! 
    145144    ! do initialisation  
    … …  
    297296    ! local declaration 
    298297    INTEGER(i_std)                                          :: ier 
     298    CHARACTER(LEN=80)                                       :: var_name            !! To store variables names for I/O 
    299299 
    300300    ! initialisation 
    … …  
    897897    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: evapot           !! Soil Potential Evaporation 
    898898    REAL(r_std),DIMENSION (kjpindex, nvm), INTENT (in)       :: humrel           !! Relative humidity 
    899 !!$ DS 15022011 humrel was used in a previous version of Orchidee, developped by Nathalie. Need to be discussed if it should be introduces again 
     899!!$ DS 15022011 humrel was used in a previous version of Orchidee, developped by Nathalie. Need to be discussed if it should be introduce again 
    900900    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: vbeta2           !! Interception resistance 
    901901    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: vbeta3           !! Vegetation resistance 

  • branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/hydrol.f90

    r433 r461  
    4242  LOGICAL, SAVE                                     :: check_cwrr=.TRUE. !! The check the water balance 
    4343 
    44   CHARACTER(LEN=80) , SAVE                          :: file_ext         !! Extention for I/O filename 
    45   CHARACTER(LEN=80) , SAVE                          :: var_name         !! To store variables names for I/O 
     44!>> DS : not used for the moment 
     45!!$  CHARACTER(LEN=80) , SAVE                          :: file_ext         !! Extention for I/O filename 
     46 
    4647  REAL(r_std), PARAMETER                             :: allowed_err =  1.0E-8_r_std 
    4748 
    … …  
    241242    ! local declaration 
    242243    ! 
    243     INTEGER(i_std)                                    :: jst, jsl 
     244    INTEGER(i_std)                                     :: jst, jsl 
    244245    REAL(r_std),DIMENSION (kjpindex)                   :: soilwet          !! A temporary diagnostic of soil wetness 
    245246    REAL(r_std),DIMENSION (kjpindex)                   :: snowdepth        !! Depth of snow layer 
     247    CHARACTER(LEN=80)                                  :: var_name         !! To store variables names for I/O 
     248 
    246249    ! 
    247250    ! do initialisation 
    … …  
    489492    INTEGER(i_std)                                     :: ier, ierror, ipdt 
    490493    INTEGER(i_std)                                     :: ji, jv, jst, jsl, ik 
     494    CHARACTER(LEN=80)                                  :: var_name         !! To store variables names for I/O 
    491495 
    492496    ! initialisation 

  • branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/hydrolc.f90

    r433 r461  
    4040  ! 
    4141  LOGICAL, SAVE                                     :: check_waterbal=.FALSE. !! The check the water balance 
    42  
    43   CHARACTER(LEN=80) , SAVE                          :: var_name         !! To store variables names for I/O 
    4442 
    4543  ! one dimension array allocated, computed, saved and got in hydrol module 
    … …  
    168166    INTEGER(i_std)                                     :: ji,jv 
    169167    REAL(r_std), DIMENSION(kjpindex)                   :: histvar          !! computations for history files 
     168    CHARACTER(LEN=80)                                  :: var_name         !! To store variables names for I/O 
    170169 
    171170    ! 
    … …  
    438437     
    439438    REAL(r_std), DIMENSION(kjpindex)                   :: a_subgrd 
     439    CHARACTER(LEN=80)                                  :: var_name         !! To store variables names for I/O 
    440440 
    441441    ! initialisation 

  • branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/sechiba.f90

    r277 r461  
    131131  ! 
    132132  LOGICAL, SAVE                                   :: l_first_sechiba = .TRUE.!! Initialisation has to be done one time 
    133   CHARACTER(LEN=80) , SAVE                             :: var_name                !! To store variables names for I/O 
    134133 
    135134  LOGICAL, SAVE                                   :: river_routing           !! Flag that decides if we route. 
    … …  
    255254    REAL(r_std), ALLOCATABLE, DIMENSION (:,:)                :: shumdiag1 
    256255 
     256    ! local 
    257257    REAL(r_std), DIMENSION(kjpindex)                   :: histvar          !! computations for history files 
    258  
     258    CHARACTER(LEN=80)                                  :: var_name         !! To store variables names for I/O 
    259259 
    260260    ! 15/03/2011 DS Add for externalisation 

  • branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/thermosoil.f90

    r257 r461  
    3535  ! 
    3636  LOGICAL, SAVE                             :: l_first_thermosoil=.TRUE. !! Initialisation has to be done one time 
    37  
    38   CHARACTER(LEN=80) , SAVE                  :: var_name                  !! To store variables names for I/O 
    3937  REAL(r_std), SAVE                          :: lambda, cstgrnd, lskin, fz1, zalph 
    4038 
    … …  
    106104    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: soilflx           
    107105    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (inout):: stempdiag        !! diagnostic temp profile 
    108  
     106    ! local 
    109107    REAL(r_std),DIMENSION (kjpindex,ngrnd) :: temp 
    110108    REAL(r_std),DIMENSION (kjpindex,ngrnd-1) :: temp1 
    111109    REAL(r_std),DIMENSION (kjpindex) :: temp2 
     110    CHARACTER(LEN=80)                :: var_name                  !! To store variables names for I/O 
     111 
    112112    ! 
    113113    ! do initialisation 
    … …  
    252252        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit, z1, 'scatter', nbp_glo, index_g) 
    253253 
    254             var_name= 'pcapa' 
     254        var_name= 'pcapa' 
    255255        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd, 1, kjit, pcapa, 'scatter', nbp_glo, index_g) 
    256256 
    257             var_name= 'pcapa_en' 
     257        var_name= 'pcapa_en' 
    258258        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd, 1, kjit, pcapa_en, 'scatter', nbp_glo, index_g) 
    259259 
    260             var_name= 'pkappa' 
     260        var_name= 'pkappa' 
    261261        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd, 1, kjit, pkappa, 'scatter', nbp_glo, index_g) 
    262262 
    263             var_name= 'zdz1' 
     263        var_name= 'zdz1' 
    264264        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd-1, 1, kjit, zdz1, 'scatter', nbp_glo, index_g) 
    265265 
    266             var_name= 'zdz2' 
     266        var_name= 'zdz2' 
    267267        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd, 1, kjit, zdz2, 'scatter', nbp_glo, index_g) 
    268268 
    … …  
    342342    ! local declaration 
    343343    INTEGER(i_std)                                     :: ier 
     344    CHARACTER(LEN=80)                                  :: var_name            !! To store variables names for I/O 
    344345 
    345346    ! initialisation 
    … …  
    466467        ! 
    467468        ! change restart If they were not found in the restart file 
    468 ! 
    469 !Config Key  = THERMOSOIL_TPRO 
    470 !Config Desc = Initial soil temperature profile if not found in restart 
    471 !Config Def  = 280. 
    472 !Config Help = The initial value of the temperature profile in the soil if  
    473 !Config        its value is not found in the restart file. This should only  
    474 !Config        be used if the model is started without a restart file. Here 
    475 !Config        we only require one value as we will assume a constant  
    476 !Config        throughout the column. 
    477 ! 
     469        ! 
     470        !Config Key  = THERMOSOIL_TPRO 
     471        !Config Desc = Initial soil temperature profile if not found in restart 
     472        !Config Def  = 280. 
     473        !Config Help = The initial value of the temperature profile in the soil if  
     474        !Config        its value is not found in the restart file. This should only  
     475        !Config        be used if the model is started without a restart file. Here 
     476        !Config        we only require one value as we will assume a constant  
     477        !Config        throughout the column. 
     478        ! 
    478479        CALL setvar_p (ptn, val_exp,'THERMOSOIL_TPRO',280._r_std) 
    479480 
Note: See TracChangeset for help on using the changeset viewer.