New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13135 – NEMO

Changeset 13135


Ignore:
Timestamp:
2020-06-19T17:37:47+02:00 (5 years ago)
Author:
orioltp
Message:

dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation: merge with trunk@13134, see #2364

Location:
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation
Files:
1 deleted
143 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation

    • Property svn:externals

      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@12931        sette 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg

    r12489 r13135  
    8181   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    8282                     ! Sea-ice : 
    83    nn_ice      = 2         !  =2 or 3 automatically for SI3 or CICE    ("key_si3" or "key_cice") 
    84                            !          except in AGRIF zoom where it has to be specified 
     83   nn_ice      = 2         !  =0 no ice boundary condition 
     84      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     85      !                    !  =2 or 3 for SI3 and CICE, respectively 
    8586                     ! Misc. options of sbc :  
    8687   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg

    r12489 r13135  
    7878   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    7979                     ! Sea-ice : 
    80    nn_ice      = 2         !  =0   Use SI3 model 
     80   nn_ice      = 2         !  =0 no ice boundary condition 
     81      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     82      !                    !  =2 or 3 for SI3 and CICE, respectively 
    8183                     ! Misc. options of sbc :  
    8284   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg

    r12489 r13135  
    7878   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    7979                     ! Sea-ice : 
    80    nn_ice      = 2         !  =0   Use SI3 model 
     80   nn_ice      = 2         !  =0 no ice boundary condition 
     81      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     82      !                    !  =2 or 3 for SI3 and CICE, respectively 
    8183                     ! Misc. options of sbc :  
    8284   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg

    r12489 r13135  
    8181   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    8282                     ! Sea-ice : 
    83    nn_ice      = 2         !  =2 or 3 automatically for SI3 or CICE    ("key_si3" or "key_cice") 
    84                            !          except in AGRIF zoom where it has to be specified 
     83   nn_ice      = 2         !  =0 no ice boundary condition 
     84      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     85      !                    !  =2 or 3 for SI3 and CICE, respectively 
    8586                     ! Misc. options of sbc :  
    8687   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/C1D_PAPA/EXPREF/file_def_nemo-oce.xml

    r9799 r13135  
    5353        <file id="file4" name_suffix="_grid_W" description="ocean W grid variables" > 
    5454          <field field_ref="e3w" /> 
    55           <field field_ref="woce"         name="wo"       /> 
    5655          <field field_ref="avt"          name="difvho"   /> 
    5756        </file> 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/C1D_PAPA/EXPREF/namelist_cfg

    r12489 r13135  
    4949&namdom        !   time and space domain 
    5050!----------------------------------------------------------------------- 
     51   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time 
     52   ! 
    5153   rn_Dt      =  360.     !  time step for the dynamics and tracer 
    5254/ 
    … …  
    358360&namdyn_spg    !   surface pressure gradient                            (default: NO selection) 
    359361!----------------------------------------------------------------------- 
    360    ln_dynspg_ts   = .true.   ! split-explicit free surface 
    361       ln_bt_fw      = .false.     ! Forward integration of barotropic Eqs. 
    362       ln_bt_av      = .true.     ! Time filtering of barotropic variables 
    363362/ 
    364363!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/C1D_PAPA/MY_SRC/usrdef_zgr.F90

    r12377 r13135  
    3030   PUBLIC   usr_def_zgr        ! called by domzgr.F90 
    3131 
     32   !! * Substitutions 
     33#  include "do_loop_substitute.h90" 
    3234   !!---------------------------------------------------------------------- 
    3335   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    157159         pe3vw(:,:,jk) = pe3w_1d (jk) 
    158160      END DO 
    159       DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points 
    160          DO ji = 1, jpi 
    161             ik = k_bot(ji,jj) 
    162             pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 
    163             pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 
    164             pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  )  
    165             ! 
    166             pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp 
    167             pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 
    168             pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  ) 
    169          END DO 
    170       END DO          
     161      ! bottom scale factors and depth at T- and W-points 
     162      DO_2D_11_11 
     163         ik = k_bot(ji,jj) 
     164         pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 
     165         pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 
     166         pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  )  
     167         ! 
     168         pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp 
     169         pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 
     170         pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  ) 
     171      END_2D         
    171172      !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points 
    172173      !                                   ! usually Computed as the minimum of neighbooring scale factors 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/ORCA2_ICE_ABL/EXPREF/namelist_cfg

    r12489 r13135  
    8484   ln_abl      = .true.    !  ABL  formulation                          (T => fill namsbc_abl ) 
    8585                     ! Sea-ice : 
    86    nn_ice      = 2         !  =2 or 3 automatically for SI3 or CICE    ("key_si3" or "key_cice") 
    87                            !          except in AGRIF zoom where it has to be specified 
     86   nn_ice      = 2         !  =0 no ice boundary condition 
     87      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     88      !                    !  =2 or 3 for SI3 and CICE, respectively 
    8889                     ! Misc. options of sbc :  
    8990   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r12501 r13135  
    8080   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    8181                     ! Sea-ice : 
    82    nn_ice      = 2         !  =2 or 3 automatically for SI3 or CICE    ("key_si3" or "key_cice") 
    83                            !          except in AGRIF zoom where it has to be specified 
     82   nn_ice      = 2         !  =0 no ice boundary condition 
     83      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     84      !                    !  =2 or 3 for SI3 and CICE, respectively 
    8485                     ! Misc. options of sbc :  
    8586   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_top_cfg

    r12377 r13135  
    2020! 
    2121   ln_trcdta     =  .true.  !  Initialisation from data input file (T) or not (F) 
    22    ln_trcbc      =  .true.  !  Enables Boundary conditions 
     22   ln_trcbc      =  .false. !  Enables Boundary conditions 
    2323!                !           !                                           !             !         ! 
    2424!                !    name   !           title of the field              !   units     ! init    ! sbc    ! cbc    !  obc  !  

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/ORCA2_OFF_PISCES/EXPREF/namelist_top_cfg

    r12377 r13135  
    2020! 
    2121   ln_trcdta     =  .true.   !  Initialisation from data input file (T) or not (F) 
    22    ln_trcbc      =  .true.   !  Enables Boundary conditions 
     22   ln_trcbc      =  .false.  !  Enables Boundary conditions 
    2323!                !           !                                           !             !         ! 
    2424!                !    name   !           title of the field              !   units     ! init    ! sbc    ! cbc    !  obc  !  

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/ORCA2_SAS_ICE/EXPREF/namelist_cfg

    r12377 r13135  
    5959   nn_fsbc     = 1         !  frequency of SBC module call 
    6060   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    61    nn_ice      = 2         !  =2  sea-ice model                         ("key_SI3" or "key_cice") 
     61   nn_ice      = 2         !  =0 no ice boundary condition 
     62      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
     63      !                    !  =2 or 3 for SI3 and CICE, respectively 
    6264/ 
    6365!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/SHARED/field_def_nemo-oce.xml

    r12377 r13135  
    1 <?xml version="1.0"?>  
     1<?xml version="1.0"?> 
    22    <!-- $id$ --> 
    33 
    … …  
    1616                         Configuration of multiple-linear-regression analysis (diamlr) 
    1717       ===================================================================================================== 
    18         
     18 
    1919       This field group configures diamlr for tidal harmonic analysis of field 
    2020       ssh: in addition to a regressor for fitting the mean value (diamlr_r101), 
    … …  
    7373 
    7474    </field_group> 
    75      
    76     <!--  
     75 
     76    <!-- 
    7777============================================================================================================ 
    7878=                                  definition of all existing variables                                    = 
    … …  
    101101    </field_group> 
    102102 
    103     <!--  
     103    <!-- 
    104104============================================================================================================ 
    105105                                  Physical ocean model variables 
    … …  
    108108 
    109109      <!-- T grid --> 
    110        
     110 
    111111      <field_group id="grid_T" grid_ref="grid_T_2D" > 
    112112        <field id="e3t"          long_name="T-cell thickness"                    standard_name="cell_thickness"        unit="m"   grid_ref="grid_T_3D" /> 
    113113        <field id="e3ts"         long_name="T-cell thickness"   field_ref="e3t"  standard_name="cell_thickness"        unit="m"   grid_ref="grid_T_SFC"/> 
    114114        <field id="e3t_0"        long_name="Initial T-cell thickness"            standard_name="ref_cell_thickness"    unit="m"   grid_ref="grid_T_3D" /> 
    115         <field id="e3tb"         long_name="bottom T-cell thickness"             standard_name="bottom_cell_thickness" unit="m"   grid_ref="grid_T_2D"/>  
     115        <field id="e3tb"         long_name="bottom T-cell thickness"             standard_name="bottom_cell_thickness" unit="m"   grid_ref="grid_T_2D"/> 
    116116        <field id="e3t_300"      field_ref="e3t"                grid_ref="grid_T_zoom_300"       detect_missing_value="true" /> 
    117117        <field id="e3t_vsum300"  field_ref="e3t_300"            grid_ref="grid_T_vsum"   detect_missing_value="true" /> 
    118118   <field id="masscello"    long_name="Sea Water Mass per unit area"   standard_name="sea_water_mass_per_unit_area"   unit="kg/m2"   grid_ref="grid_T_3D"/> 
    119         <field id="volcello"     long_name="Ocean Volume"                   standard_name="ocean_volume"   unit="m3"       grid_ref="grid_T_3D"/>  
     119        <field id="volcello"     long_name="Ocean Volume"                   standard_name="ocean_volume"   unit="m3"       grid_ref="grid_T_3D"/> 
    120120        <field id="toce"         long_name="temperature"                         standard_name="sea_water_potential_temperature"   unit="degC"     grid_ref="grid_T_3D"/> 
    121121        <field id="toce_e3t"     long_name="temperature (thickness weighted)"                                                      unit="degC"     grid_ref="grid_T_3D" > toce * e3t </field > 
    … …  
    146146        <field id="sst_cs"       long_name="Delta SST of cool skin"                                                                                 unit="degC"     /> 
    147147   <field id="temp_3m"      long_name="temperature at 3m"                                                                                      unit="degC"     /> 
    148          
     148 
    149149        <field id="sss"          long_name="sea surface salinity"                               standard_name="sea_surface_salinity"                unit="1e-3"     /> 
    150150        <field id="sss2"         long_name="square of sea surface salinity"                                                                         unit="1e-6"      > sss * sss </field > 
    … …  
    152152        <field id="sssmin"       long_name="min of sea surface salinity"      field_ref="sss"   operation="minimum"                                                 /> 
    153153        <field id="sbs"          long_name="sea bottom salinity"                                                                                    unit="0.001"    /> 
    154         <field id="somint"       long_name="vertical integral of salinity times density"        standard_name="integral_wrt_depth_of_product_of_density_and_salinity"  unit="(kg m2) x (1e-3)" />  
    155  
    156         <field id="taubot"       long_name="bottom stress module"                                                                                   unit="N/m2"     />  
     154        <field id="somint"       long_name="vertical integral of salinity times density"        standard_name="integral_wrt_depth_of_product_of_density_and_salinity"  unit="(kg m2) x (1e-3)" /> 
     155 
     156        <field id="taubot"       long_name="bottom stress module"                                                                                   unit="N/m2"     /> 
    157157 
    158158         <!-- Case EOS = TEOS-10 : output potential temperature --> 
    … …  
    295295        <field id="us_y"        long_name="j component of Stokes drift"                      unit="m/s"     /> 
    296296      </field_group> 
    297        
     297 
    298298      <!-- SBC --> 
    299299      <field_group id="SBC" > <!-- time step automaticaly defined based on nn_fsbc --> 
    … …  
    311311          <field id="precip"       long_name="Total precipitation"                  standard_name="precipitation_flux"                                                   unit="kg/m2/s"   /> 
    312312          <field id="wclosea"      long_name="closed sea empmr correction"          standard_name="closea_empmr"                                                         unit="kg/m2/s"   /> 
    313       
     313 
    314314          <field id="qt"           long_name="Net Downward Heat Flux"                standard_name="surface_downward_heat_flux_in_sea_water"                              unit="W/m2"                           /> 
    315315          <field id="qns"          long_name="non solar Downward Heat Flux"                                                                                               unit="W/m2"                           /> 
    … …  
    321321          <field id="taum"         long_name="wind stress module"                    standard_name="magnitude_of_surface_downward_stress"                                 unit="N/m2"                           /> 
    322322          <field id="wspd"         long_name="wind speed module"                     standard_name="wind_speed"                                                           unit="m/s"                            /> 
    323            
     323 
    324324          <!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn --> 
    325325          <field id="ssh_ib"       long_name="Inverse barometer sea surface height"  standard_name="sea_surface_height_correction_due_to_air_pressure_at_low_frequency"   unit="m"        /> 
    … …  
    369369          <field id="taum_oce"     long_name="wind stress module over open ocean"           standard_name="magnitude_of_surface_downward_stress"               unit="N/m2"  /> 
    370370 
     371          <!-- variables computed by the bulk parameterization algorithms (ln_blk) --> 
     372          <field id="Cd_oce"      long_name="Drag coefficient over open ocean"              standard_name="drag_coefficient_water"                unit=""  /> 
     373          <field id="Ce_oce"      long_name="Evaporaion coefficient over open ocean"        standard_name="evap_coefficient_water"                unit=""  /> 
     374          <field id="Ch_oce"      long_name="Sensible heat coefficient over open ocean"     standard_name="sensible_heat_coefficient_water"       unit=""  /> 
     375          <field id="theta_zt"    long_name="Potential air temperature at z=zt"             standard_name="potential_air_temperature_at_zt"       unit="degC" /> 
     376          <field id="q_zt"        long_name="Specific air humidity at z=zt"                 standard_name="specific_air_humidity_at_zt"           unit="kg/kg" /> 
     377          <field id="theta_zu"    long_name="Potential air temperature at z=zu"             standard_name="potential_air_temperature_at_zu"       unit="degC" /> 
     378          <field id="q_zu"        long_name="Specific air humidity at z=zu"                 standard_name="specific_air_humidity_at_zu"           unit="kg/kg" /> 
     379          <field id="ssq"         long_name="Saturation specific humidity of air at z=0"    standard_name="surface_air_saturation_spec_humidity"  unit="kg/kg" /> 
     380          <field id="wspd_blk"    long_name="Bulk wind speed at z=zu"                       standard_name="bulk_wind_speed_at_zu"                 unit="m/s"   /> 
     381          <!-- ln_blk + key_si3 --> 
     382          <field id="Cd_ice"      long_name="Drag coefficient over ice"                     standard_name="drag_coefficient_ice"                 unit=""  /> 
     383          <field id="Ce_ice"      long_name="Evaporaion coefficient over ice"               standard_name="evap_coefficient_ice"                 unit=""  /> 
     384          <field id="Ch_ice"      long_name="Sensible heat coefficient over ice"            standard_name="sensible_heat_coefficient_ice"        unit=""  /> 
     385 
    371386          <!-- available key_oasis3 --> 
    372387          <field id="snow_ao_cea"  long_name="Snow over ice-free ocean (cell average)"   standard_name="snowfall_flux"                             unit="kg/m2/s"  /> 
    … …  
    405420          <!-- ice field (nn_ice=1)  --> 
    406421          <field id="ice_cover"    long_name="Ice fraction"                                                 standard_name="sea_ice_area_fraction"                              unit="1"            /> 
    407            
     422 
    408423          <!-- dilution --> 
    409424          <field id="emp_x_sst"    long_name="Concentration/Dilution term on SST"                                                                                              unit="kg*degC/m2/s" /> 
    410           <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                                                                                              unit="kg*1e-3/m2/s" />         
     425          <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                                                                                              unit="kg*1e-3/m2/s" /> 
    411426          <field id="rnf_x_sst"    long_name="Runoff term on SST"                                                                                                              unit="kg*degC/m2/s" /> 
    412427          <field id="rnf_x_sss"    long_name="Runoff term on SSS"                                                                                                              unit="kg*1e-3/m2/s" /> 
    413       
     428 
    414429     <!-- sbcssm variables --> 
    415430          <field id="sst_m"    unit="degC" /> 
    … …  
    422437 
    423438   </field_group> 
    424     
     439 
    425440 
    426441      </field_group> <!-- SBC --> 
    427        
     442 
    428443      <!-- ABL --> 
    429444      <field_group id="ABL" > <!-- time step automaticaly defined based on nn_fsbc --> 
    … …  
    456471          <field id="uz1_dta"    long_name="DTA i-horizontal velocity"     standard_name="dta_x_velocity" unit="m/s"      /> 
    457472          <field id="vz1_dta"    long_name="DTA j-horizontal velocity"     standard_name="dta_y_velocity" unit="m/s"      /> 
    458           <field id="uvz1_dta"   long_name="DTA wind speed module"         standard_name="dta_wind_speed" unit="m/s"       > sqrt( uz1_dta^2 + vz1_dta^2 ) </field>  
     473          <field id="uvz1_dta"   long_name="DTA wind speed module"         standard_name="dta_wind_speed" unit="m/s"       > sqrt( uz1_dta^2 + vz1_dta^2 ) </field> 
    459474          <field id="tz1_dta"    long_name="DTA potential temperature"     standard_name="dta_theta"      unit="K"        /> 
    460475          <field id="qz1_dta"    long_name="DTA specific humidity"         standard_name="dta_qspe"       unit="kg/kg"    /> 
    … …  
    462477          <field id="uz1_geo"    long_name="GEO i-horizontal velocity"     standard_name="geo_x_velocity" unit="m/s"      /> 
    463478          <field id="vz1_geo"    long_name="GEO j-horizontal velocity"     standard_name="geo_y_velocity" unit="m/s"      /> 
    464           <field id="uvz1_geo"   long_name="GEO wind speed module"         standard_name="geo_wind_speed" unit="m/s"       > sqrt( uz1_geo^2 + vz1_geo^2 ) </field>  
     479          <field id="uvz1_geo"   long_name="GEO wind speed module"         standard_name="geo_wind_speed" unit="m/s"       > sqrt( uz1_geo^2 + vz1_geo^2 ) </field> 
    465480   </field_group> 
    466481 
    467482      </field_group> <!-- ABL --> 
    468483 
    469        
     484 
    470485      <!-- U grid --> 
    471        
     486 
    472487      <field_group id="grid_U"   grid_ref="grid_U_2D"> 
    473488        <field id="e2u"           long_name="U-cell width in meridional direction"                   standard_name="cell_width"                  unit="m"                               /> 
    … …  
    478493      <field id="uoce_e3u"      long_name="ocean current along i-axis  (thickness weighted)"                                                   unit="m/s"        grid_ref="grid_U_3D"  > uoce * e3u </field> 
    479494      <field id="uoce_e3u_vsum" long_name="ocean current along i-axis * e3u summed on the vertical"  field_ref="uoce_e3u"    unit="m3/s"       grid_ref="grid_U_vsum"/> 
    480         <field id="uocetr_vsum"   long_name="ocean transport along i-axis  summed on the vertical"         field_ref="e2u"       unit="m3/s"> this * uoce_e3u_vsum  </field>  
     495        <field id="uocetr_vsum"   long_name="ocean transport along i-axis  summed on the vertical"         field_ref="e2u"       unit="m3/s"> this * uoce_e3u_vsum  </field> 
    481496 
    482497        <field id="uocetr_vsum_op"    long_name="ocean current along i-axis * e3u * e2u summed on the vertical"  read_access="true"  freq_op="1mo"    field_ref="e2u"       unit="m3/s"> @uocetr_vsum </field> 
    483         <field id="uocetr_vsum_cumul" long_name="ocean current along i-axis * e3u * e2u cumulated from southwest point" freq_offset="_reset_" operation="instant" freq_op="1mo"  unit="m3/s" />  
     498        <field id="uocetr_vsum_cumul" long_name="ocean current along i-axis * e3u * e2u cumulated from southwest point" freq_offset="_reset_" operation="instant" freq_op="1mo"  unit="m3/s" /> 
    484499        <field id="msftbarot"         long_name="ocean_barotropic_mass_streamfunction"   unit="kg s-1" > uocetr_vsum_cumul * $rau0 </field> 
    485500 
    … …  
    534549        <field id="udiff_salttr"  long_name="ocean diffusion salt transport along i-axis"                     standard_name="ocean_salt_x_transport_due_to_diffusion"        unit="1e-3*kg/s"                 /> 
    535550      </field_group> 
    536        
     551 
    537552      <!-- V grid --> 
    538        
     553 
    539554      <field_group id="grid_V"   grid_ref="grid_V_2D"> 
    540555        <field id="e1v"          long_name="V-cell width in longitudinal direction"                 standard_name="cell_width"                  unit="m"                              /> 
    … …  
    593608        <field id="vdiff_salttr"  long_name="ocean diffusion salt transport along j-axis"   standard_name="ocean_salt_y_transport_due_to_diffusion"         unit="1e-3*kg/s"                 /> 
    594609      </field_group> 
    595        
     610 
    596611      <!-- W grid --> 
    597        
     612 
    598613      <field_group id="grid_W" grid_ref="grid_W_3D"> 
    599614        <field id="e3w"          long_name="W-cell thickness"                              standard_name="cell_thickness"                         unit="m"    /> 
    600615   <field id="woce"         long_name="ocean vertical velocity"                       standard_name="upward_sea_water_velocity"              unit="m/s"  /> 
    601    <field id="woce_e3w"     long_name="ocean vertical velocity * e3w"                                                                        unit="m2/s"  > woce * e3w </field>   
     616   <field id="woce_e3w"     long_name="ocean vertical velocity * e3w"                                                                        unit="m2/s"  > woce * e3w </field> 
    602617        <field id="wocetr_eff"   long_name="effective ocean vertical transport"                                                                   unit="m3/s" /> 
    603618 
    … …  
    609624 
    610625   <field id="avt"          long_name="vertical eddy diffusivity"                      standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" /> 
    611         <field id="avt_e3w"      long_name="vertical heat diffusivity * e3w"                unit="m3/s" > avt * e3w </field>      
     626        <field id="avt_e3w"      long_name="vertical heat diffusivity * e3w"                unit="m3/s" > avt * e3w </field> 
    612627        <field id="logavt"       long_name="logarithm of vertical eddy diffusivity"         standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" /> 
    613628        <field id="avm"          long_name="vertical eddy viscosity"                        standard_name="ocean_vertical_momentum_diffusivity"   unit="m2/s" /> 
    614         <field id="avm_e3w"      long_name="vertical eddy viscosity * e3w"   unit="m3/s" > avm * e3w </field>  
     629        <field id="avm_e3w"      long_name="vertical eddy viscosity * e3w"   unit="m3/s" > avm * e3w </field> 
    615630 
    616631        <!-- avs: /= avt with ln_zdfddm=T --> 
    617632        <field id="avs"          long_name="salt vertical eddy diffusivity"                 standard_name="ocean_vertical_salt_diffusivity"       unit="m2/s" /> 
    618         <field id="avs_e3w"      long_name="vertical salt diffusivity * e3w"   unit="m3/s" > avs * e3w </field>  
     633        <field id="avs_e3w"      long_name="vertical salt diffusivity * e3w"   unit="m3/s" > avs * e3w </field> 
    619634   <field id="logavs"       long_name="logarithm of salt vertical eddy diffusivity"    standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" /> 
    620635 
    621636        <!-- avt_evd and avm_evd: available with ln_zdfevd --> 
    622637        <field id="avt_evd"      long_name="convective enhancement of vertical diffusivity" standard_name="ocean_vertical_tracer_diffusivity_due_to_convection"     unit="m2/s" /> 
    623         <field id="avt_evd_e3w"  long_name="convective enhancement to vertical diffusivity * e3w "    unit="m3/s" > avt_evd * e3w </field>  
     638        <field id="avt_evd_e3w"  long_name="convective enhancement to vertical diffusivity * e3w "    unit="m3/s" > avt_evd * e3w </field> 
    624639   <field id="avm_evd"      long_name="convective enhancement of vertical viscosity"   standard_name="ocean_vertical_momentum_diffusivity_due_to_convection"   unit="m2/s" /> 
    625640 
    … …  
    634649        <field id="wstokes"      long_name="Stokes Drift vertical velocity"                 standard_name="upward_StokesDrift_velocity"   unit="m/s" /> 
    635650 
    636         <!-- variables available with diaar5 -->    
     651        <!-- variables available with diaar5 --> 
    637652        <field id="w_masstr"     long_name="vertical mass transport"                        standard_name="upward_ocean_mass_transport"             unit="kg/s"   /> 
    638653        <field id="w_masstr2"    long_name="square of vertical mass transport"              standard_name="square_of_upward_ocean_mass_transport"   unit="kg2/s2" /> 
    639654 
    640655      </field_group> 
    641        
     656 
    642657      <!-- F grid --> 
    643658      <!-- AGRIF sponge --> 
    … …  
    694709      </field_group> 
    695710 
    696        
     711 
    697712      <!-- variables available with ln_floats --> 
    698713 
    … …  
    709724      <!-- variables available with iceberg trajectories --> 
    710725 
    711       <field_group id="icbvar" domain_ref="grid_T"  >  
     726      <field_group id="icbvar" domain_ref="grid_T"  > 
    712727        <field id="berg_melt"          long_name="icb melt rate of icebergs"                       unit="kg/m2/s"                    /> 
    713728        <field id="berg_melt_hcflx"    long_name="icb heat flux to ocean due to melting heat content"   unit="J/m2/s"                /> 
    … …  
    727742      </field_group> 
    728743 
    729       <!-- Poleward transport : ptr -->      
    730       <field_group id="diaptr" >   
     744      <!-- Poleward transport : ptr --> 
     745      <field_group id="diaptr" > 
    731746        <field id="zomsf"         long_name="Overturning Stream-Function : All basins"                     unit="Sv"         grid_ref="grid_znl_W_3D" /> 
    732747        <field id="zotem"         long_name="Zonal Mean Temperature : All basins"                          unit="degree_C"   grid_ref="grid_znl_T_3D" /> 
    … …  
    736751        <field id="sopstove"      long_name="Overturning Salt Transport: All basins"                       unit="Giga g/s"   grid_ref="grid_znl_T_2D" /> 
    737752        <field id="sophtbtr"      long_name="Barotropic Heat Transport: All basins"                        unit="PW"         grid_ref="grid_znl_T_2D" /> 
    738         <field id="sopstbtr"      long_name="Barotropic Salt Transport: All basins"                        unit="Giga g/s"   grid_ref="grid_znl_T_2D" />  
     753        <field id="sopstbtr"      long_name="Barotropic Salt Transport: All basins"                        unit="Giga g/s"   grid_ref="grid_znl_T_2D" /> 
    739754        <field id="sophtadv"      long_name="Advective Heat Transport: All basins"                         unit="PW"         grid_ref="grid_znl_T_2D" /> 
    740755        <field id="sopstadv"      long_name="Advective Salt Transport: All basins"                         unit="Giga g/s"   grid_ref="grid_znl_T_2D" /> 
    … …  
    742757        <field id="sopstldf"      long_name="Diffusive Salt Transport: All basins"                         unit="Giga g/s"   grid_ref="grid_znl_T_2D" /> 
    743758        <field id="sophtvtr"      long_name="Heat Transport : All basins"                                  unit="PW"         grid_ref="grid_znl_T_2D" /> 
    744         <field id="sopstvtr"      long_name="Salt Transport : All basins"                                  unit="Giga g/s"   grid_ref="grid_znl_T_2D" />   
     759        <field id="sopstvtr"      long_name="Salt Transport : All basins"                                  unit="Giga g/s"   grid_ref="grid_znl_T_2D" /> 
    745760        <field id="sophteiv"      long_name="Heat Transport from mesoscale eddy advection: All basins"     unit="PW"         grid_ref="grid_znl_T_2D" /> 
    746761        <field id="sopsteiv"      long_name="Salt Transport from mesoscale eddy advection : All basins"    unit="Giga g/s"   grid_ref="grid_znl_T_2D" /> 
    … …  
    758773 
    759774 
    760     <!--  
     775    <!-- 
    761776============================================================================================================ 
    762777                  Physical ocean model trend diagnostics : temperature, KE, PE, momentum 
    … …  
    899914     <field id="ketrd_zdf"     long_name="ke-trend: vertical  diffusion"                    unit="W/s^3"                        /> 
    900915     <field id="ketrd_tau"     long_name="ke-trend: wind stress "                           unit="W/s^3"   grid_ref="grid_T_2D" /> 
    901      <field id="ketrd_bfr"     long_name="ke-trend: bottom friction (explicit)"             unit="W/s^3"                        />    
    902      <field id="ketrd_bfri"    long_name="ke-trend: bottom friction (implicit)"             unit="W/s^3"                        />    
    903      <field id="ketrd_atf"     long_name="ke-trend: asselin time filter trend"              unit="W/s^3"                        />   
     916     <field id="ketrd_bfr"     long_name="ke-trend: bottom friction (explicit)"             unit="W/s^3"                        /> 
     917     <field id="ketrd_bfri"    long_name="ke-trend: bottom friction (implicit)"             unit="W/s^3"                        /> 
     918     <field id="ketrd_atf"     long_name="ke-trend: asselin time filter trend"              unit="W/s^3"                        /> 
    904919     <field id="ketrd_convP2K" long_name="ke-trend: conversion (potential to kinetic)"      unit="W/s^3"                        /> 
    905      <field id="KE"            long_name="kinetic energy: u(n)*u(n+1)/2"                    unit="W/s^2"                        />    
     920     <field id="KE"            long_name="kinetic energy: u(n)*u(n+1)/2"                    unit="W/s^2"                        /> 
    906921 
    907922     <!-- variables available when explicit lateral mixing is used (ln_dynldf_OFF=F) --> 
    908      <field id="dispkexyfo"    long_name="KE-trend: lateral  mixing induced dissipation"   standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction"                   unit="W/m^2" grid_ref="grid_T_2D" />    
    909      <field id="dispkevfo"     long_name="KE-trend: vertical mixing induced dissipation"   standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_vertical_friction"             unit="W/m^2" grid_ref="grid_T_2D" />    
     923     <field id="dispkexyfo"    long_name="KE-trend: lateral  mixing induced dissipation"   standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction"                   unit="W/m^2" grid_ref="grid_T_2D" /> 
     924     <field id="dispkevfo"     long_name="KE-trend: vertical mixing induced dissipation"   standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_vertical_friction"             unit="W/m^2" grid_ref="grid_T_2D" /> 
    910925     <!-- variables available with ln_traadv_eiv=T and ln_diaeiv=T --> 
    911      <field id="eketrd_eiv"    long_name="EKE-trend due to parameterized eddy advection"   standard_name="tendency_of_ocean_eddy_kinetic_energy_content_due_to_parameterized_eddy_advection"   unit="W/m^2" grid_ref="grid_T_2D" />    
     926     <field id="eketrd_eiv"    long_name="EKE-trend due to parameterized eddy advection"   standard_name="tendency_of_ocean_eddy_kinetic_energy_content_due_to_parameterized_eddy_advection"   unit="W/m^2" grid_ref="grid_T_2D" /> 
    912927 
    913928     <!-- variables available with ln_PE_trd --> 
    … …  
    926941     <field id="petrd_bbc"     long_name="pe-trend: geothermal heating"         unit="W/m^3"                        /> 
    927942     <field id="petrd_atf"     long_name="pe-trend: asselin time filter"        unit="W/m^3"                        /> 
    928      <field id="PEanom"        long_name="potential energy anomaly"             unit="1"                            />    
    929      <field id="alphaPE"       long_name="partial deriv. of PEanom wrt T"       unit="degC-1"                       />    
    930      <field id="betaPE"        long_name="partial deriv. of PEanom wrt S"       unit="1e3"                          />    
     943     <field id="PEanom"        long_name="potential energy anomaly"             unit="1"                            /> 
     944     <field id="alphaPE"       long_name="partial deriv. of PEanom wrt T"       unit="degC-1"                       /> 
     945     <field id="betaPE"        long_name="partial deriv. of PEanom wrt S"       unit="1e3"                          /> 
    931946   </field_group> 
    932947 
    … …  
    945960     <field id="utrd_zdf"       long_name="i-trend: vertical  diffusion"                    unit="m/s^2"                        /> 
    946961     <field id="utrd_tau"       long_name="i-trend: wind stress "                           unit="m/s^2"   grid_ref="grid_U_2D" /> 
    947      <field id="utrd_bfr"       long_name="i-trend: bottom friction (explicit)"             unit="m/s^2"                        />    
    948      <field id="utrd_bfri"      long_name="i-trend: bottom friction (implicit)"             unit="m/s^2"                        />    
    949      <field id="utrd_tot"       long_name="i-trend: total momentum trend before atf"        unit="m/s^2"                        />    
    950      <field id="utrd_atf"       long_name="i-trend: asselin time filter trend"              unit="m/s^2"                        />    
     962     <field id="utrd_bfr"       long_name="i-trend: bottom friction (explicit)"             unit="m/s^2"                        /> 
     963     <field id="utrd_bfri"      long_name="i-trend: bottom friction (implicit)"             unit="m/s^2"                        /> 
     964     <field id="utrd_tot"       long_name="i-trend: total momentum trend before atf"        unit="m/s^2"                        /> 
     965     <field id="utrd_atf"       long_name="i-trend: asselin time filter trend"              unit="m/s^2"                        /> 
    951966   </field_group> 
    952967 
    … …  
    965980     <field id="vtrd_zdf"       long_name="j-trend: vertical  diffusion"                    unit="m/s^2"                        /> 
    966981     <field id="vtrd_tau"       long_name="j-trend: wind stress "                           unit="m/s^2"   grid_ref="grid_V_2D" /> 
    967      <field id="vtrd_bfr"       long_name="j-trend: bottom friction (explicit)"             unit="m/s^2"                        />    
    968      <field id="vtrd_bfri"      long_name="j-trend: bottom friction (implicit)"             unit="m/s^2"                        />    
    969      <field id="vtrd_tot"       long_name="j-trend: total momentum trend before atf"        unit="m/s^2"                        />    
    970      <field id="vtrd_atf"       long_name="j-trend: asselin time filter trend"              unit="m/s^2"                        />    
     982     <field id="vtrd_bfr"       long_name="j-trend: bottom friction (explicit)"             unit="m/s^2"                        /> 
     983     <field id="vtrd_bfri"      long_name="j-trend: bottom friction (implicit)"             unit="m/s^2"                        /> 
     984     <field id="vtrd_tot"       long_name="j-trend: total momentum trend before atf"        unit="m/s^2"                        /> 
     985     <field id="vtrd_atf"       long_name="j-trend: asselin time filter trend"              unit="m/s^2"                        /> 
    971986   </field_group> 
    972987 
    973988 
    974     <!--  
     989    <!-- 
    975990============================================================================================================ 
    976991                                        Definitions for iodef_demo.xml 
    … …  
    9901005      <field field_ref="strd_zdfp_li"    name="osaltdiff" /> 
    9911006    </field_group> 
    992      
     1007 
    9931008    <field_group id="mooring" > 
    9941009      <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"      /> 
    … …  
    9991014      <field field_ref="avt"          name="difvho"   long_name="ocean_vertical_heat_diffusivity"      /> 
    10001015      <field field_ref="avm"          name="difvmo"   long_name="ocean_vertical_momentum_diffusivity"  /> 
    1001        
     1016 
    10021017      <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       /> 
    10031018      <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             /> 
    … …  
    10471062      <field field_ref="BLT"          name="blt"      long_name="Barrier Layer Thickness"                       /> 
    10481063    </field_group> 
    1049      
     1064 
    10501065    <field_group id="groupU" > 
    10511066      <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      /> 
    10521067      <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" /> 
    10531068    </field_group> 
    1054      
     1069 
    10551070    <field_group id="groupV" > 
    10561071      <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      /> 
    10571072      <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" /> 
    10581073    </field_group> 
    1059      
     1074 
    10601075    <field_group id="groupW" > 
    10611076      <field field_ref="woce"         name="wo"       long_name="ocean vertical velocity"  /> 
    … …  
    11001115    </field_group> 
    11011116 
    1102     <!--  
     1117    <!-- 
    11031118============================================================================================================ 
    11041119    --> 
    1105     <!-- output variables for my configuration (example) -->  
    1106      
     1120    <!-- output variables for my configuration (example) --> 
     1121 
    11071122    <field_group id="myvarOCE" > 
    1108       <!-- grid T -->  
     1123      <!-- grid T --> 
    11091124      <field field_ref="e3t"          name="e3t"      long_name="vertical scale factor"           /> 
    11101125      <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"         /> 
    11111126      <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"            /> 
    11121127      <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"  /> 
    1113        
    1114       <!-- grid U -->  
     1128 
     1129      <!-- grid U --> 
    11151130      <field field_ref="e3u"          name="e3u"     long_name="vertical scale factor"            /> 
    11161131      <field field_ref="ssu"          name="uos"     long_name="sea_surface_x_velocity"           /> 
    1117        
    1118       <!-- grid V -->  
     1132 
     1133      <!-- grid V --> 
    11191134      <field field_ref="e3v"          name="e3v"     long_name="vertical scale factor"            /> 
    1120       <field field_ref="ssv"          name="vos"     long_name="sea_surface_y_velocity"           />      
    1121     </field_group>     
     1135      <field field_ref="ssv"          name="vos"     long_name="sea_surface_y_velocity"           /> 
     1136    </field_group> 
    11221137 
    11231138   </field_definition> 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/SHARED/namelist_pisces_ref

    r12377 r13135  
    352352! 
    353353   cn_dir      = './'      !  root directory for the location of the dynamical files 
    354    ln_ironsed  =  .true.   ! boolean for Fe input from sediments 
    355    ln_ironice  =  .true.   ! boolean for Fe input from sea ice 
    356    ln_hydrofe  =  .true.   ! boolean for from hydrothermal vents 
     354   ln_ironsed  =  .false.   ! boolean for Fe input from sediments 
     355   ln_ironice  =  .false.   ! boolean for Fe input from sea ice 
     356   ln_hydrofe  =  .false.   ! boolean for from hydrothermal vents 
    357357   sedfeinput  =  2.e-9    ! Coastal release of Iron 
    358358   distcoast   =  5.e3     ! Distance off the coast for Iron from sediments 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/SHARED/namelist_ref

    r12530 r13135  
    11341134   !                       !                 = 3 as =2 with distinct dissipative an mixing length scale 
    11351135   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F) 
     1136      nn_mxlice    = 0        ! type of scaling under sea-ice 
     1137                              !    = 0 no scaling under sea-ice 
     1138                              !    = 1 scaling with constant sea-ice thickness 
     1139                              !    = 2  scaling with mean sea-ice thickness ( only with SI3 sea-ice model ) 
     1140                              !    = 3  scaling with maximum sea-ice thickness 
     1141      rn_mxlice   = 10.       ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 
    11361142   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value 
    11371143   ln_drg      = .false.   !  top/bottom friction added as boundary condition of TKE 
    … …  
    13941400&namctl        !   Control prints                                       (default: OFF) 
    13951401!----------------------------------------------------------------------- 
    1396    sn_cfctl%l_glochk = .FALSE.    ! Range sanity checks are local (F) or global (T). Set T for debugging only 
    1397    sn_cfctl%l_allon  = .FALSE.    ! IF T activate all options. If F deactivate all unless l_config is T 
    1398      sn_cfctl%l_config = .TRUE.     ! IF .true. then control which reports are written with the following 
    1399        sn_cfctl%l_runstat = .TRUE.  ! switches and which areas produce reports with the proc integer settings. 
    1400        sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure 
    1401        sn_cfctl%l_oceout  = .FALSE. ! that  all areas report. 
    1402        sn_cfctl%l_layout  = .FALSE. ! 
    1403        sn_cfctl%l_prtctl  = .FALSE. ! 
    1404        sn_cfctl%l_prttrc  = .FALSE. ! 
    1405        sn_cfctl%l_oasout  = .FALSE. ! 
    1406        sn_cfctl%procmin   = 0       ! Minimum area number for reporting [default:0] 
    1407        sn_cfctl%procmax   = 1000000 ! Maximum area number for reporting [default:1000000] 
    1408        sn_cfctl%procincr  = 1       ! Increment for optional subsetting of areas [default:1] 
    1409        sn_cfctl%ptimincr  = 1       ! Timestep increment for writing time step progress info 
    1410    nn_print    =    0      !  level of print (0 no extra print) 
    1411    nn_ictls    =    0      !  start i indice of control sum (use to compare mono versus 
    1412    nn_ictle    =    0      !  end   i indice of control sum        multi processor runs 
    1413    nn_jctls    =    0      !  start j indice of control               over a subdomain) 
    1414    nn_jctle    =    0      !  end   j indice of control 
    1415    nn_isplt    =    1      !  number of processors in i-direction 
    1416    nn_jsplt    =    1      !  number of processors in j-direction 
    1417    ln_timing   = .false.   !  timing by routine write out in timing.output file 
    1418    ln_diacfl   = .false.   !  CFL diagnostics write out in cfl_diagnostics.ascii 
     1402   sn_cfctl%l_runstat = .TRUE.    ! switches and which areas produce reports with the proc integer settings. 
     1403   sn_cfctl%l_trcstat = .FALSE.   ! The default settings for the proc integers should ensure 
     1404   sn_cfctl%l_oceout  = .FALSE.   ! that  all areas report. 
     1405   sn_cfctl%l_layout  = .FALSE.   ! 
     1406   sn_cfctl%l_prtctl  = .FALSE.   ! 
     1407   sn_cfctl%l_prttrc  = .FALSE.   ! 
     1408   sn_cfctl%l_oasout  = .FALSE.   ! 
     1409   sn_cfctl%procmin   = 0         ! Minimum area number for reporting [default:0] 
     1410   sn_cfctl%procmax   = 1000000   ! Maximum area number for reporting [default:1000000] 
     1411   sn_cfctl%procincr  = 1         ! Increment for optional subsetting of areas [default:1] 
     1412   sn_cfctl%ptimincr  = 1         ! Timestep increment for writing time step progress info 
     1413   nn_print    =    0             !  level of print (0 no extra print) 
     1414   nn_ictls    =    0             !  start i indice of control sum (use to compare mono versus 
     1415   nn_ictle    =    0             !  end   i indice of control sum        multi processor runs 
     1416   nn_jctls    =    0             !  start j indice of control               over a subdomain) 
     1417   nn_jctle    =    0             !  end   j indice of control 
     1418   nn_isplt    =    1             !  number of processors in i-direction 
     1419   nn_jsplt    =    1             !  number of processors in j-direction 
     1420   ln_timing   = .false.          !  timing by routine write out in timing.output file 
     1421   ln_diacfl   = .false.          !  CFL diagnostics write out in cfl_diagnostics.ascii 
    14191422/ 
    14201423!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/WED025/EXPREF/file_def_nemo-ice.xml

    r11844 r13135  
    7878     </file> 
    7979      
    80      <file id="file22" name_suffix="_SBC_scalar" description="scalar variables" enabled=".true." > 
    81        <!-- global contents --> 
    82        <field field_ref="ibgvol_tot"     grid_ref="grid_1point"   name="ibgvol_tot"   /> 
    83        <field field_ref="sbgvol_tot"     grid_ref="grid_1point"   name="sbgvol_tot"   /> 
    84        <field field_ref="ibgarea_tot"    grid_ref="grid_1point"   name="ibgarea_tot"  /> 
    85        <field field_ref="ibgsalt_tot"    grid_ref="grid_1point"   name="ibgsalt_tot"  /> 
    86        <field field_ref="ibgheat_tot"    grid_ref="grid_1point"   name="ibgheat_tot"  /> 
    87        <field field_ref="sbgheat_tot"    grid_ref="grid_1point"   name="sbgheat_tot"  /> 
    88         
    89        <!-- global drifts (conservation checks) --> 
    90        <field field_ref="ibgvolume"      grid_ref="grid_1point"   name="ibgvolume"    /> 
    91        <field field_ref="ibgsaltco"      grid_ref="grid_1point"   name="ibgsaltco"    /> 
    92        <field field_ref="ibgheatco"      grid_ref="grid_1point"   name="ibgheatco"    /> 
    93        <field field_ref="ibgheatfx"      grid_ref="grid_1point"   name="ibgheatfx"    /> 
    94         
    95        <!-- global forcings  --> 
    96        <field field_ref="ibgfrcvoltop"   grid_ref="grid_1point"   name="ibgfrcvoltop" /> 
    97        <field field_ref="ibgfrcvolbot"   grid_ref="grid_1point"   name="ibgfrcvolbot" /> 
    98        <field field_ref="ibgfrctemtop"   grid_ref="grid_1point"   name="ibgfrctemtop" /> 
    99        <field field_ref="ibgfrctembot"   grid_ref="grid_1point"   name="ibgfrctembot" /> 
    100        <field field_ref="ibgfrcsal"      grid_ref="grid_1point"   name="ibgfrcsal"    /> 
    101        <field field_ref="ibgfrchfxtop"   grid_ref="grid_1point"   name="ibgfrchfxtop" /> 
    102        <field field_ref="ibgfrchfxbot"   grid_ref="grid_1point"   name="ibgfrchfxbot" /> 
    103      </file> 
    104       
    10580   </file_group> 
    10681    

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/WED025/EXPREF/namelist_cfg

    r12489 r13135  
    55!! namelists    2 - Surface boundary (namsbc, namsbc_flx, namsbc_blk, namsbc_cpl, 
    66!!                                    namsbc_sas, namtra_qsr, namsbc_rnf, 
    7 !!                                    namsbc_isf, namsbc_iscpl, namsbc_apr,  
     7!!                                    namisf, namsbc_apr,  
    88!!                                    namsbc_ssr, namsbc_wave, namberg) 
    99!!              3 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide) 
    … …  
    3838   nn_it000    =   1       !  first time step 
    3939   nn_itend    =  26280    !  last  time step (std 5475) 
    40    nn_date0    = 19760301  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
     40   nn_date0    = 20000101  !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    4141   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
    4242      nn_rstctl   =    2      !  restart control ==> activated only if ln_rstart=T 
    … …  
    6161   ln_tsd_init = .true.          !  ocean initialisation 
    6262   ln_tsd_dmp  = .false.         !  T-S restoring   (see namtra_dmp) 
    63     
     63 
    6464   cn_dir      = './'      !  root directory for the T-S data location 
    65    !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    66    !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
    67    !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                  ! pairing  !    filename   ! 
    68    sn_tem = 'dta_temp_WED025'            ,         -12       , 'votemper',   .true.    , .true. , 'yearly'  ,    ''            ,    ''    ,    '' 
    69    sn_sal = 'dta_sal_WED025'             ,         -12       , 'vosaline',   .true.    , .true. , 'yearly'  ,    ''            ,    ''    ,    '' 
     65   !___________!_____________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
     66   !           !  file name          ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
     67   !           !                     !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                  ! pairing  !    filename   ! 
     68   sn_tem = 'WED025_init_JRA_200001.nc',       -12       , 'votemper',   .false.   , .true. , 'yearly'  ,    ''            ,    ''    ,    '' 
     69   sn_sal = 'WED025_init_JRA_200001.nc',       -12       , 'vosaline',   .false.   , .true. , 'yearly'  ,    ''            ,    ''    ,    '' 
    7070/ 
    7171!----------------------------------------------------------------------- 
    … …  
    116116   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk ) 
    117117                     ! Sea-ice : 
    118    nn_ice      = 2         !  =0 no ice boundary condition     
     118   nn_ice      = 2         !  =0 no ice boundary condition 
    119119      !                    !  =1 use observed ice-cover                 (  => fill namsbc_iif ) 
    120       !                    !  =2 or 3 automatically for SI3 or CICE    ("key_si3" or "key_cice") 
    121       !                    !          except in AGRIF zoom where it has to be specified 
     120      !                    !  =2 or 3 for SI3 and CICE, respectively 
    122121   ln_ice_embd = .false.   !  =T embedded sea-ice (pressure + mass and salt exchanges) 
    123122      !                    !  =F levitating ice (no pressure, mass and salt exchanges) 
    124123                     ! Misc. options of sbc :  
    125124   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 
    126    ln_dm2dc    = .true.    !  daily mean to diurnal cycle on short wave 
     125   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave 
    127126   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
    128127   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
    … …  
    141140   ln_NCAR     = .true.   ! "NCAR"      algorithm   (Large and Yeager 2008) 
    142141   ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    143    ln_COARE_3p5 = .false.   ! "COARE 3.5" algorithm   (Edson et al. 2013) 
    144    ln_ECMWF    = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
     142   ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     143   ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 45r1) 
    145144 
    146145   cn_dir      = './'      !  root directory for the bulk data location 
    … …  
    148147   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ !       weights filename               ! rotation ! land/sea mask ! 
    149148   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                                      ! pairing  !    filename   ! 
    150    sn_wndi     = 'u10_core'              ,         6         , 'U_10_MOD',   .true.    , .false. , 'yearly'  , 'weights_bicubic_core.nc'           , 'Uwnd'   , '' 
    151    sn_wndj     = 'v10_core'              ,         6         , 'V_10_MOD',   .true.    , .false. , 'yearly'  , 'weights_bicubic_core.nc'           , 'Vwnd'   , '' 
    152    sn_qsr      = 'qsw_core'              ,        24         , 'SWDN_MOD',   .false.   , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
    153    sn_qlw      = 'qlw_core'              ,        24         , 'LWDN_MOD',   .false.   , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
    154    sn_tair     = 't10_core'              ,         6         , 'T_10_MOD',   .true.    , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
    155    sn_humi     = 'q10_core'              ,         6         , 'Q_10_MOD',   .true.    , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
    156    sn_prec     = 'precip_core'           ,        -1         , 'TPRECIP',    .true.    , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
    157    sn_snow     = 'snow_core'             ,        -1         , 'SNOW'    ,   .true.    , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
    158    sn_slp      = 'slp_core'              ,         6         , 'SLP'     ,   .true.    , .false. , 'yearly'  , 'weights_bilin_core.nc'             , ''       , '' 
     149   sn_wndi     = 'u10_JRA'              ,         3         , 'uas_10m' ,   .true.    , .false. , 'yearly'  , 'weights_bicubic_JRA.nc'           , 'Uwnd'   , '' 
     150   sn_wndj     = 'v10_JRA'              ,         3         , 'vas_10m' ,   .true.    , .false. , 'yearly'  , 'weights_bicubic_JRA.nc'           , 'Vwnd'   , '' 
     151   sn_qsr      = 'rsds_JRA'             ,         3         , 'rsds'    ,   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
     152   sn_qlw      = 'rlds_JRA'             ,         3         , 'rlds'    ,   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
     153   sn_tair     = 't10_JRA'              ,         3         , 'tas_10m' ,   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
     154   sn_humi     = 'q10_JRA'              ,         3         , 'huss_10m',   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
     155   sn_prec     = 'precip_JRA'           ,         3         , 'prto'    ,   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
     156   sn_snow     = 'snow_JRA'             ,         3         , 'prsn'    ,   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
     157   sn_slp      = 'slp_JRA'              ,         3         , 'psl'     ,   .true.    , .false. , 'yearly'  , 'weights_bilin_JRA.nc'             , ''       , '' 
    159158/ 
    160159!----------------------------------------------------------------------- 
    … …  
    201200   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
    202201   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                  ! pairing  !    filename   ! 
    203    sn_rnf      = 'runoff_WED025'         ,  -1               , 'runoff'  ,   .true.    , .false., 'yearly'  , ''               , ''       , '' 
     202   sn_rnf      = 'WED025_icb'         ,  -1               , 'runoff'  ,   .true.    , .false., 'yearly'  , ''               , ''       , '' 
    204203/ 
    205204!----------------------------------------------------------------------- 
    … …  
    221220         cn_isfcav_mlt = '3eq'   ! ice shelf melting formulation (spe/2eq/3eq/oasis) 
    222221         !                       ! spe = fwfisf is read from a forcing field 
    223          !                       ! 2eq = ISOMIP  like: 2 equations formulation (Hunter et al., 2006) 
    224          !                       ! 3eq = ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015) 
     222         !                       ! 2eq = ISOMIP  like: 2 equations formulation (Hunter et al., 2006 for a short description) 
     223         !                       ! 3eq = ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2016 for a short description) 
    225224         !                       ! oasis = fwfisf is given by oasis and pattern by file sn_isfcav_fwf 
    226225         !              !  cn_isfcav_mlt = 2eq or 3eq cases: 
    227226         cn_gammablk = 'vel'     ! scheme to compute gammat/s (spe,ad15,hj99) 
    228          !                       ! ad15 = velocity dependend Gamma (u* * gammat/s)  (Jenkins et al. 2010) 
    229          !                       ! hj99 = velocity and stability dependent Gamma    (Holland et al. 1999) 
    230          rn_gammat0  = 1.4e-2    ! gammat coefficient used in blk formula 
    231          rn_gammas0  = 4.e-4    ! gammas coefficient used in blk formula 
     227         !                       ! spe      = constant transfert velocity (rn_gammat0, rn_gammas0) 
     228         !                       ! vel      = velocity dependent transfert velocity (u* * gammat/s) (Asay-Davis et al. 2016 for a short description) 
     229         !                       ! vel_stab = velocity and stability dependent transfert coeficient (Holland et al. 1999 for a complete description) 
     230         rn_gammat0  = 1.4e-2    ! gammat coefficient used in spe, vel and vel_stab gamma computation method 
     231         rn_gammas0  = 4.0e-4    ! gammas coefficient used in spe, vel and vel_stab gamma computation method 
    232232         ! 
    233233         rn_htbl     =  30.      ! thickness of the top boundary layer    (Losh et al. 2008) 
    … …  
    255255         sn_isfpar_zmin = 'isfmlt_par',      -12.      , 'sozisfmin' ,  .false.    , .true.  , 'yearly'  ,    ''    ,   ''     ,    '' 
    256256         !* 'spe' and 'oasis' case 
    257          sn_isfpar_fwf = 'isfmlt_par' ,      -12.      , 'sofwfisf' ,  .false.    , .true.  , 'yearly'   ,    ''    ,   ''     ,    '' 
     257         sn_isfpar_fwf = 'isfmlt_par' ,      -12.      ,'sofwfisf' ,  .false.    , .true.  , 'yearly'   ,    ''    ,   ''     ,    '' 
    258258         !* 'bg03' case 
    259          sn_isfpar_Leff = 'isfmlt_par',       0.       , 'Leff'     ,  .false.    , .true.  , 'yearly'   ,    ''    ,   ''     ,    '' 
     259         sn_isfpar_Leff = 'isfmlt_par',       0.       ,'Leff'     ,  .false.    , .true.  , 'yearly'   ,    ''    ,   ''     ,    '' 
    260260      ! 
    261261      ! ---------------- ice sheet coupling ------------------------------- 
    … …  
    300300   ln_tide     = .true.       ! Activate tides 
    301301      ln_tide_pot   = .false.               !  use tidal potential forcing 
    302       clname(1) = 'M2'  !  name of constituent - all tidal components must be set in namelist_cfg 
    303       clname(2) = 'S2' 
    304       clname(3) = 'K1' 
    305       clname(4) = 'O1' 
     302      sn_tide_cnames(1) = 'M2'  !  name of constituent - all tidal components must be set in namelist_cfg 
     303      sn_tide_cnames(2) = 'S2' 
     304      sn_tide_cnames(3) = 'K1' 
     305      sn_tide_cnames(4) = 'O1' 
    306306/ 
    307307!----------------------------------------------------------------------- 
    … …  
    340340   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
    341341   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                  ! pairing  !    filename   ! 
    342    bn_ssh      =    'bdyT_ssh_WED025'    ,         -1        , 'sossheig' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    343    bn_u2d      =    'bdyU_u2d_WED025'    ,         -1        , 'vobtcrtx' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    344    bn_v2d      =    'bdyV_u2d_WED025'    ,         -1        , 'vobtcrty' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    345    bn_u3d      =    'bdyU_u3d_WED025'    ,         -1        , 'vozocrtx' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    346    bn_v3d      =    'bdyV_u3d_WED025'    ,         -1        , 'vomecrty' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    347    bn_tem      =    'bdyT_tra_WED025'    ,         -1        , 'votemper' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    348    bn_sal      =    'bdyT_tra_WED025'    ,         -1        , 'vosaline' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     342   bn_ssh      =    'WED025_bdyT_ssh'    ,         -1        , 'sossheig' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     343   bn_u2d      =    'WED025_bdyU_u2d'    ,         -1        , 'vobtcrtx' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     344   bn_v2d      =    'WED025_bdyV_u2d'    ,         -1        , 'vobtcrty' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     345   bn_u3d      =    'WED025_bdyU_u3d'    ,         -1        , 'vozocrtx' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     346   bn_v3d      =    'WED025_bdyV_u3d'    ,         -1        , 'vomecrty' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     347   bn_tem      =    'WED025_bdyT_tra'    ,         -1        , 'votemper' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     348   bn_sal      =    'WED025_bdyT_tra'    ,         -1        , 'vosaline' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    349349!* for si3 
    350    bn_a_i      =    'bdyT_ice_WED025'    ,         -1        , 'ileadfra' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    351    bn_h_i      =    'bdyT_ice_WED025'    ,         -1        , 'iicethic' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    352    bn_h_s      =    'bdyT_ice_WED025'    ,         -1        , 'isnowthi' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     350   bn_a_i      =    'WED025_bdyT_ice'    ,         -1        , 'ileadfra' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     351   bn_h_i      =    'WED025_bdyT_ice'    ,         -1        , 'iicethic' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
     352   bn_h_s      =    'WED025_bdyT_ice'    ,         -1        , 'isnowthi' ,     .true. , .false., 'yearly'  ,    ''            ,   ''     ,     '' 
    353353/ 
    354354!----------------------------------------------------------------------- 
    355355&nambdy_tide   !  tidal forcing at open boundaries                      (default: OFF) 
    356356!----------------------------------------------------------------------- 
    357    filtide          = 'bdytide_WED025_'         !  file name root of tidal forcing files 
     357   filtide          = 'WED025_bdytide_'         !  file name root of tidal forcing files 
    358358/ 
    359359 
    … …  
    658658&namctl        !   Control prints                                       (default: OFF) 
    659659!----------------------------------------------------------------------- 
    660    ln_ctl = .FALSE.                 ! Toggle all report printing on/off (T/F); Ignored if sn_cfctl%l_config is T 
    661      sn_cfctl%l_config = .TRUE.     ! IF .true. then control which reports are written with the following 
    662        sn_cfctl%l_runstat = .FALSE. ! switches and which areas produce reports with the proc integer settings. 
    663        sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure 
    664        sn_cfctl%l_oceout  = .FALSE. ! that  all areas report. 
    665        sn_cfctl%l_layout  = .FALSE. ! 
    666        sn_cfctl%l_mppout  = .FALSE. ! 
    667        sn_cfctl%l_mpptop  = .FALSE. ! 
    668        sn_cfctl%procmin   = 0       ! Minimum area number for reporting [default:0] 
    669        sn_cfctl%procmax   = 1000000 ! Maximum area number for reporting [default:1000000] 
    670        sn_cfctl%procincr  = 1       ! Increment for optional subsetting of areas [default:1] 
    671        sn_cfctl%ptimincr  = 1       ! Timestep increment for writing time step progress info 
    672    nn_print    =    0      !  level of print (0 no extra print) 
    673    nn_ictls    =    0      !  start i indice of control sum (use to compare mono versus 
    674    nn_ictle    =    0      !  end   i indice of control sum        multi processor runs 
    675    nn_jctls    =    0      !  start j indice of control               over a subdomain) 
    676    nn_jctle    =    0      !  end   j indice of control 
    677    nn_isplt    =    1      !  number of processors in i-direction 
    678    nn_jsplt    =    1      !  number of processors in j-direction 
    679    ln_timing   = .true.    !  timing by routine write out in timing.output file 
    680    ln_diacfl   = .false.   !  CFL diagnostics write out in cfl_diagnostics.ascii 
     660   sn_cfctl%l_runstat = .true.    ! switches and which areas produce reports with the proc integer settings. 
     661   ln_timing   = .true.           !  timing by routine write out in timing.output file 
    681662/ 
    682663!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/WED025/EXPREF/namelist_ice_cfg

    r11487 r13135  
    2626&namitd         !   Ice discretization 
    2727!------------------------------------------------------------------------------ 
     28   ln_cat_hfn       = .true.          !  ice categories are defined by a function following rn_himean**(-0.05) 
     29      rn_himean     =   2.0           !  expected domain-average ice thickness (m) 
     30   rn_himin         =   0.01          !  minimum ice thickness (m) used in remapping 
    2831/ 
    2932!------------------------------------------------------------------------------ 
    3033&namdyn         !   Ice dynamics 
    3134!------------------------------------------------------------------------------ 
     35   ln_landfast_L16  = .true.          !  landfast: parameterization from Lemieux 2016 
    3236/ 
    3337!------------------------------------------------------------------------------ 
    … …  
    4246&namdyn_adv     !   Ice advection 
    4347!------------------------------------------------------------------------------ 
     48   ln_adv_Pra       = .false.         !  Advection scheme (Prather) 
     49   ln_adv_UMx       = .true.          !  Advection scheme (Ultimate-Macho) 
     50      nn_UMx        =   5             !     order of the scheme for UMx (1-5 ; 20=centered 2nd order) 
    4451/ 
    4552!------------------------------------------------------------------------------ 
    … …  
    6269&namthd_do      !   Ice growth in open water 
    6370!------------------------------------------------------------------------------ 
     71   rn_hinew         =   0.02          !  thickness for new ice formation in open water (m), must be larger than rn_himin 
     72   ln_frazil        = .true.          !  Frazil ice parameterization (ice collection as a function of wind) 
    6473/ 
    6574!------------------------------------------------------------------------------ 
    … …  
    7079&namthd_pnd     !   Melt ponds 
    7180!------------------------------------------------------------------------------ 
     81   ln_pnd           = .true.          !  activate melt ponds or not 
     82     ln_pnd_H12     = .true.          !  activate evolutive melt ponds (from Holland et al 2012) 
     83     ln_pnd_alb     = .true.          !  melt ponds affect albedo or not 
    7284/ 
     85 
    7386!------------------------------------------------------------------------------ 
    7487&namini         !   Ice initialization 
    7588!------------------------------------------------------------------------------ 
     89   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
     90   ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     91   ! -- for ln_iceini_file = T 
     92   sn_hti = 'WED025_init_JRA_200001.nc', -12 ,'icethic_cea',  .false.  , .true., 'yearly'  , '' , '', '' 
     93   sn_hts = 'WED025_init_JRA_200001.nc', -12 ,'icesnow_cea',  .false.  , .true., 'yearly'  , '' , '', '' 
     94   sn_ati = 'WED025_init_JRA_200001.nc', -12 ,'ice_cover'  ,  .false.  , .true., 'yearly'  , '' , '', '' 
     95   sn_smi = 'NOT USED'              , -12 ,'smi'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     96   sn_tmi = 'NOT USED'              , -12 ,'tmi'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     97   sn_tsu = 'NOT USED'              , -12 ,'tsu'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     98   sn_tms = 'NOT USED'              , -12 ,'tms'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     99   !      melt ponds (be careful, sn_apd is the pond concentration (not fraction), so it differs from rn_apd) 
     100   sn_apd = 'NOT USED'              , -12 ,'apd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     101   sn_hpd = 'NOT USED'              , -12 ,'hpd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     102   cn_dir='./' 
    76103/ 
    77104!------------------------------------------------------------------------------ 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/cfgs/ref_cfgs.txt

    r12377 r13135  
    77ORCA2_OFF_TRC OCE TOP OFF 
    88ORCA2_SAS_ICE OCE ICE NST SAS 
    9 ORCA2_ICE_PISCES OCE TOP ICE NST 
     9ORCA2_ICE_PISCES OCE TOP ICE NST ABL 
    1010ORCA2_ICE_ABL OCE ICE ABL 
    11 ORCA2_SAS_ICE_ABL OCE SAS ICE ABL 
    12 ORCA2_ICE OCE ICE 
    1311SPITZ12 OCE ICE 
    1412WED025 OCE ICE 
    15 eORCA025_ICE OCE ICE 
    16 eORCA025_ICE_ABL OCE ICE ABL 
    17 eORCA025_SAS_ICE_ABL OCE SAS ICE ABL 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ABL/ablmod.F90

    r12546 r13135  
    592592      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    593593      !                            !  8 *** Swap time indices for the next timestep 
    594       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
    595       nt_n = 1 + MOD( kt  , 2) 
    596       nt_a = 1 + MOD( kt+1, 2) 
    597       !     
     594      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     595      nt_n = 1 + MOD( nt_n, 2) 
     596      nt_a = 1 + MOD( nt_a, 2) 
     597      ! 
    598598!--------------------------------------------------------------------------------------------------- 
    599599   END SUBROUTINE abl_stp 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ABL/ablrst.F90

    r11945 r13135  
    7474            ENDIF 
    7575            ! 
    76             CALL iom_open( TRIM(clpath)//TRIM(clname), numraw, ldwrt = .TRUE., kdlev = jpka ) 
     76            CALL iom_open( TRIM(clpath)//TRIM(clname), numraw, ldwrt = .TRUE., kdlev = jpka, cdcomp = 'ABL' ) 
    7777            lrst_abl = .TRUE. 
    7878         ENDIF 
    … …  
    146146      ENDIF 
    147147 
    148       CALL iom_open ( TRIM(cn_ablrst_indir)//'/'//cn_ablrst_in, numrar, kdlev = jpka ) 
     148      CALL iom_open ( TRIM(cn_ablrst_indir)//'/'//cn_ablrst_in, numrar ) 
    149149 
    150150      ! Time info 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ABL/par_abl.F90

    r12489 r13135  
    2929   LOGICAL , PUBLIC            ::   ln_smth_pblh   !: smoothing of atmospheric PBL height  
    3030 
     31   LOGICAL           , PUBLIC ::   ln_rstart_abl    !: (de)activate abl restart 
    3132   CHARACTER(len=256), PUBLIC ::   cn_ablrst_in     !: suffix of abl restart name (input) 
    3233   CHARACTER(len=256), PUBLIC ::   cn_ablrst_out    !: suffix of abl restart name (output) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ABL/sbcabl.F90

    r12489 r13135  
    6868      LOGICAL            ::   lluldl 
    6969      NAMELIST/namsbc_abl/ cn_dir, cn_dom, cn_ablrst_in, cn_ablrst_out,           & 
    70          &                 cn_ablrst_indir, cn_ablrst_outdir,                     & 
     70         &                 cn_ablrst_indir, cn_ablrst_outdir, ln_rstart_abl,      & 
    7171         &                 ln_hpgls_frc, ln_geos_winds, nn_dyn_restore,           & 
    7272         &                 rn_ldyn_min , rn_ldyn_max, rn_ltra_min, rn_ltra_max,   & 
    … …  
    7575      !!--------------------------------------------------------------------- 
    7676 
    77       REWIND( numnam_ref )              ! Namelist namsbc_abl in reference namelist : ABL parameters 
     77      ! Namelist namsbc_abl in reference namelist : ABL parameters 
    7878      READ  ( numnam_ref, namsbc_abl, IOSTAT = ios, ERR = 901 ) 
    7979901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in reference namelist' ) 
    80       ! 
    81       REWIND( numnam_cfg )              ! Namelist namsbc_abl in configuration namelist : ABL parameters 
     80      ! Namelist namsbc_abl in configuration namelist : ABL parameters 
    8281      READ  ( numnam_cfg, namsbc_abl, IOSTAT = ios, ERR = 902 ) 
    8382902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in configuration namelist' ) 
    … …  
    264263 
    265264      ! Initialize the time index for now time (nt_n) and after time (nt_a) 
    266       nt_n = 1 + MOD( nit000  , 2) 
    267       nt_a = 1 + MOD( nit000+1, 2) 
     265      nt_n = 1; nt_a = 2 
    268266 
    269267      ! initialize ABL from data or restart 
    270       IF( ln_rstart ) THEN 
     268      IF( ln_rstart_abl ) THEN 
    271269         CALL abl_rst_read 
    272270      ELSE 
    … …  
    289287      ENDIF 
    290288 
    291       rhoa(:,:) = rho_air( tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), sf(jp_slp)%fnow(:,:,1) ) !!GS: rhoa must be (re)computed here here to avoid division by zero in blk_ice_1 (TBI) 
    292  
    293289   END SUBROUTINE sbc_abl_init 
    294290 
    … …  
    330326      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step 
    331327 
    332       !!------------------------------------------------------------------------------------------- 
    333       !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields 
    334       !!------------------------------------------------------------------------------------------- 
    335  
    336       CALL blk_oce_1( kt,  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),   &   !   <<= in 
    337          &                tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in 
    338          &                sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m     ,   &   !   <<= in 
    339          &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) ,   &   !   <<= in 
    340          &                tsk_m, zssq, zcd_du, zsen, zevp                       )   !   =>> out 
    341  
    342 #if defined key_si3 
    343       CALL blk_ice_1(  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),    &   !   <<= in 
    344          &            tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),    &   !   <<= in 
    345          &            sf(jp_slp)%fnow(:,:,1)  ,  u_ice, v_ice, tm_su    ,    &   !   <<= in 
    346          &            pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui )   !   <<= out 
    347 #endif 
    348  
    349       !!------------------------------------------------------------------------------------------- 
    350       !! 3 - Advance ABL variables from now (n) to after (n+1) 
    351       !!------------------------------------------------------------------------------------------- 
    352  
    353       CALL abl_stp( kt, tsk_m, ssu_m, ssv_m, zssq,                          &   !   <<= in 
    354          &              sf(jp_wndi)%fnow(:,:,:), sf(jp_wndj)%fnow(:,:,:),   &   !   <<= in 
    355          &              sf(jp_tair)%fnow(:,:,:), sf(jp_humi)%fnow(:,:,:),   &   !   <<= in 
    356          &              sf(jp_slp )%fnow(:,:,1),                            &   !   <<= in 
    357          &              sf(jp_hpgi)%fnow(:,:,:), sf(jp_hpgj)%fnow(:,:,:),   &   !   <<= in 
    358          &              zcd_du, zsen, zevp,                                 &   !   <=> in/out 
    359          &              wndm, utau, vtau, taum                              &   !   =>> out 
    360 #if defined key_si3 
    361          &            , tm_su, u_ice, v_ice, zssqi, zcd_dui                 &   !   <<= in 
    362          &            , zseni, zevpi, wndm_ice, ato_i                       &   !   <<= in 
    363          &            , utau_ice, vtau_ice                                  &   !   =>> out 
    364 #endif 
    365          &                                                                  ) 
    366       !!------------------------------------------------------------------------------------------- 
    367       !! 4 - Finalize flux computation using ABL variables at (n+1), nt_n corresponds to (n+1) since 
    368       !!                                                                time swap is done in abl_stp 
    369       !!------------------------------------------------------------------------------------------- 
    370  
    371       CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta),                            & 
    372          &            sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1),   & 
    373          &            sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1),   & 
    374          &            tsk_m, zsen, zevp                                ) 
    375  
    376       CALL abl_rst_opn( kt )                       ! Open abl restart file (if necessary) 
    377       IF( lrst_abl ) CALL abl_rst_write( kt )      ! -- abl restart file 
    378  
    379 #if defined key_si3 
    380       ! Avoid a USE abl in icesbc module 
    381       sf(jp_tair)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_ta);  sf(jp_humi)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_qa) 
    382 #endif 
     328      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
     329 
     330         !!------------------------------------------------------------------------------------------- 
     331         !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields 
     332         !!------------------------------------------------------------------------------------------- 
     333 
     334         CALL blk_oce_1( kt,  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),   &   !   <<= in 
     335            &                tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in 
     336            &                sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m     ,   &   !   <<= in 
     337            &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) ,   &   !   <<= in 
     338            &                tsk_m, zssq, zcd_du, zsen, zevp                       )   !   =>> out 
     339 
     340#if defined key_si3 
     341         CALL blk_ice_1(  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),    &   !   <<= in 
     342            &            tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),    &   !   <<= in 
     343            &            sf(jp_slp)%fnow(:,:,1)  ,  u_ice, v_ice, tm_su    ,    &   !   <<= in 
     344            &            pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui )   !   <<= out 
     345#endif 
     346 
     347         !!------------------------------------------------------------------------------------------- 
     348         !! 3 - Advance ABL variables from now (n) to after (n+1) 
     349         !!------------------------------------------------------------------------------------------- 
     350    
     351         CALL abl_stp( kt, tsk_m, ssu_m, ssv_m, zssq,                          &   !   <<= in 
     352            &              sf(jp_wndi)%fnow(:,:,:), sf(jp_wndj)%fnow(:,:,:),   &   !   <<= in 
     353            &              sf(jp_tair)%fnow(:,:,:), sf(jp_humi)%fnow(:,:,:),   &   !   <<= in 
     354            &              sf(jp_slp )%fnow(:,:,1),                            &   !   <<= in 
     355            &              sf(jp_hpgi)%fnow(:,:,:), sf(jp_hpgj)%fnow(:,:,:),   &   !   <<= in 
     356            &              zcd_du, zsen, zevp,                                 &   !   <=> in/out 
     357            &              wndm, utau, vtau, taum                              &   !   =>> out 
     358#if defined key_si3 
     359            &            , tm_su, u_ice, v_ice, zssqi, zcd_dui                 &   !   <<= in 
     360            &            , zseni, zevpi, wndm_ice, ato_i                       &   !   <<= in 
     361            &            , utau_ice, vtau_ice                                  &   !   =>> out 
     362#endif 
     363            &                                                                  ) 
     364         !!------------------------------------------------------------------------------------------- 
     365         !! 4 - Finalize flux computation using ABL variables at (n+1), nt_n corresponds to (n+1) since 
     366         !!                                                                time swap is done in abl_stp 
     367         !!------------------------------------------------------------------------------------------- 
     368 
     369         CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta),                            & 
     370            &            sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1),   & 
     371            &            sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1),   & 
     372            &            tsk_m, zsen, zevp                                ) 
     373    
     374         CALL abl_rst_opn( kt )                       ! Open abl restart file (if necessary) 
     375         IF( lrst_abl ) CALL abl_rst_write( kt )      ! -- abl restart file 
     376 
     377#if defined key_si3 
     378         ! Avoid a USE abl in icesbc module 
     379         sf(jp_tair)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_ta);  sf(jp_humi)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_qa) 
     380#endif 
     381      END IF 
    383382 
    384383   END SUBROUTINE sbc_abl 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icectl.F90

    r12489 r13135  
    331331      IF(lwp) WRITE(numout,*)                 
    332332 
    333       CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
     333      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    334334       
    335335      CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 )    ! ice mass spurious lost/gain 
    … …  
    725725       
    726726      CALL prt_ctl_info(' ') 
    727       CALL prt_ctl_info(' - Heat / FW fluxes : ') 
    728       CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    729       CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    730       CALL prt_ctl(tab2d_1=qsr    , clinfo1= ' qsr   : ', tab2d_2=qns       , clinfo2= ' qns       : ') 
    731       CALL prt_ctl(tab2d_1=emp    , clinfo1= ' emp   : ', tab2d_2=sfx       , clinfo2= ' sfx       : ') 
    732        
    733       CALL prt_ctl_info(' ') 
    734727      CALL prt_ctl_info(' - Stresses : ') 
    735728      CALL prt_ctl_info('   ~~~~~~~~~~ ') 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/iceistate.F90

    r12489 r13135  
    179179            ! 
    180180            ! -- mandatory fields -- ! 
    181             zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 
    182             zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) 
    183             zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) 
     181            zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) 
     182            zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) 
     183            zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) 
    184184 
    185185            ! -- optional fields -- ! 
    … …  
    219219               &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    220220            ! 
    221             zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 
    222             ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 
    223             zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) 
    224             ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) 
    225             zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) 
    226             zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) 
     221            zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 
     222            ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) 
     223            zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) 
     224            ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) 
     225            zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 
     226            zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 
    227227            ! 
    228228            ! change the switch for the following 
    … …  
    436436!!clem: output of initial state should be written here but it is impossible because 
    437437!!      the ocean and ice are in the same file 
    438 !!      CALL dia_wri_state( 'output.init' ) 
     438!!      CALL dia_wri_state( Kmm, 'output.init' ) 
    439439      ! 
    440440   END SUBROUTINE ice_istate 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icerst.F90

    r12377 r13135  
    8080            ENDIF 
    8181            ! 
    82             CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl ) 
     82            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    8383            lrst_ice = .TRUE. 
    8484         ENDIF 
    … …  
    185185      ENDIF 
    186186 
    187       CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kdlev = jpl ) 
     187      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir ) 
    188188 
    189189      ! test if v_i exists  

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ASM/asminc.F90

    r12546 r13135  
    896896         IF ( kt == nitdin_r ) THEN 
    897897            ! 
    898             l_1st_euler = 0              ! Force Euler forward step 
     898            l_1st_euler = .TRUE.              ! Force Euler forward step 
    899899            ! 
    900900            ! Sea-ice : SI3 case 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/BDY/bdydta.F90

    r12396 r13135  
    9191      INTEGER ::  jbdy, jfld, jstart, jend, ib, jl    ! dummy loop indices 
    9292      INTEGER ::  ii, ij, ik, igrd, ipl               ! local integers 
    93       INTEGER,   DIMENSION(jpbgrd)     ::   ilen1  
    94       INTEGER,   DIMENSION(:), POINTER ::   nblen, nblenrim  ! short cuts 
    9593      TYPE(OBC_DATA)         , POINTER ::   dta_alias        ! short cut 
    9694      TYPE(FLD), DIMENSION(:), POINTER ::   bf_alias 
    … …  
    108106         DO jbdy = 1, nb_bdy 
    109107            ! 
    110             nblen    => idx_bdy(jbdy)%nblen 
    111             nblenrim => idx_bdy(jbdy)%nblenrim 
    112             ! 
    113108            IF( nn_dyn2d_dta(jbdy) == 0 ) THEN  
    114                ilen1(:) = nblen(:) 
    115109               IF( dta_bdy(jbdy)%lneed_ssh ) THEN  
    116110                  igrd = 1 
    117                   DO ib = 1, ilen1(igrd) 
     111                  DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd)   ! ssh is allocated and used only on the rim 
    118112                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    119113                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    … …  
    121115                  END DO 
    122116               ENDIF 
    123                IF( dta_bdy(jbdy)%lneed_dyn2d) THEN  
     117               IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 
    124118                  igrd = 2 
    125                   DO ib = 1, ilen1(igrd) 
     119                  DO ib = 1, SIZE(dta_bdy(jbdy)%u2d)      ! u2d is used either over the whole bdy or only on the rim 
    126120                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    127121                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    128122                     dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1)          
    129123                  END DO 
     124               ENDIF 
     125               IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 
    130126                  igrd = 3 
    131                   DO ib = 1, ilen1(igrd) 
     127                  DO ib = 1, SIZE(dta_bdy(jbdy)%v2d)      ! v2d is used either over the whole bdy or only on the rim 
    132128                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    133129                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    … …  
    138134            ! 
    139135            IF( nn_dyn3d_dta(jbdy) == 0 ) THEN  
    140                ilen1(:) = nblen(:) 
    141136               IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN  
    142137                  igrd = 2  
    143                   DO ib = 1, ilen1(igrd) 
     138                  DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    144139                     DO ik = 1, jpkm1 
    145140                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    … …  
    149144                  END DO 
    150145                  igrd = 3  
    151                   DO ib = 1, ilen1(igrd) 
     146                  DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    152147                     DO ik = 1, jpkm1 
    153148                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    … …  
    160155 
    161156            IF( nn_tra_dta(jbdy) == 0 ) THEN  
    162                ilen1(:) = nblen(:) 
    163157               IF( dta_bdy(jbdy)%lneed_tra ) THEN 
    164158                  igrd = 1  
    165                   DO ib = 1, ilen1(igrd) 
     159                  DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    166160                     DO ik = 1, jpkm1 
    167161                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    … …  
    176170#if defined key_si3 
    177171            IF( nn_ice_dta(jbdy) == 0 ) THEN    ! set ice to initial values 
    178                ilen1(:) = nblen(:) 
    179172               IF( dta_bdy(jbdy)%lneed_ice ) THEN 
    180173                  igrd = 1    
    181174                  DO jl = 1, jpl 
    182                      DO ib = 1, ilen1(igrd) 
     175                     DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    183176                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    184177                        ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    … …  
    218211         ! 
    219212         ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s) 
    220          IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN   ! runoff and we read u/v2d 
     213         IF( cn_tra(jbdy) == 'runoff' ) THEN   ! runoff 
    221214            ! 
    222             igrd = 2                      ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 
    223             DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    224                ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    225                ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    226                dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
    227             END DO 
    228             igrd = 3                      ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 
    229             DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    230                ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    231                ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    232                dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
    233             END DO 
     215            IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 
     216               igrd = 2                         ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 
     217               DO ib = 1, SIZE(dta_alias%u2d)   ! u2d is used either over the whole bdy or only on the rim 
     218                  ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
     219                  ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     220                  dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
     221               END DO 
     222            ENDIF 
     223            IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 
     224               igrd = 3                         ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 
     225               DO ib = 1, SIZE(dta_alias%v2d)   ! v2d is used either over the whole bdy or only on the rim 
     226                  ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
     227                  ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     228                  dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
     229               END DO 
     230            ENDIF 
    234231         ENDIF 
    235232 
    236233         ! tidal harmonic forcing ONLY: initialise arrays 
    237234         IF( nn_dyn2d_dta(jbdy) == 2 ) THEN   ! we did not read ssh, u/v2d  
    238             IF( dta_alias%lneed_ssh  ) dta_alias%ssh(:) = 0._wp 
    239             IF( dta_alias%lneed_dyn2d ) dta_alias%u2d(:) = 0._wp 
    240             IF( dta_alias%lneed_dyn2d ) dta_alias%v2d(:) = 0._wp 
     235            IF( ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 
     236            IF( ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 
     237            IF( ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 
    241238         ENDIF 
    242239 
    … …  
    245242            ! 
    246243            igrd = 2                       ! zonal velocity 
    247             dta_alias%u2d(:) = 0._wp       ! compute barotrope zonal velocity and put it in u2d 
    248244            DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    249245               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    250246               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     247               dta_alias%u2d(ib) = 0._wp   ! compute barotrope zonal velocity and put it in u2d 
    251248               DO ik = 1, jpkm1 
    252249                  dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 
    … …  
    258255            END DO 
    259256            igrd = 3                       ! meridional velocity 
    260             dta_alias%v2d(:) = 0._wp       ! compute barotrope meridional velocity and put it in v2d 
    261257            DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    262258               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    263259               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     260               dta_alias%v2d(ib) = 0._wp   ! compute barotrope meridional velocity and put it in v2d 
    264261               DO ik = 1, jpkm1 
    265262                  dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 
    … …  
    283280 
    284281#if defined key_si3 
    285          IF( dta_alias%lneed_ice ) THEN 
     282         IF( dta_alias%lneed_ice .AND. idx_bdy(jbdy)%nblen(1) > 0 ) THEN 
    286283            ! fill temperature and salinity arrays 
    287284            IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy) 
    … …  
    338335            DO jbdy = 1, nb_bdy      ! Tidal component added in ts loop 
    339336               IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 
    340                   nblen => idx_bdy(jbdy)%nblen 
    341                   nblenrim => idx_bdy(jbdy)%nblenrim 
    342                   IF( cn_dyn2d(jbdy) == 'frs' ) THEN   ;   ilen1(:)=nblen(:) 
    343                   ELSE                                 ;   ilen1(:)=nblenrim(:) 
    344                   ENDIF 
    345                   IF ( dta_bdy(jbdy)%lneed_ssh   ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 
    346                   IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 
    347                   IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 
     337                  IF( ASSOCIATED(dta_bdy(jbdy)%ssh) ) dta_bdy_s(jbdy)%ssh(:) = dta_bdy(jbdy)%ssh(:) 
     338                  IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) dta_bdy_s(jbdy)%u2d(:) = dta_bdy(jbdy)%u2d(:) 
     339                  IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) dta_bdy_s(jbdy)%v2d(:) = dta_bdy(jbdy)%v2d(:) 
    348340               ENDIF 
    349341            END DO 
    350342         ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 
    351343            ! 
    352             ! BDY: use pt_offset=1.0 as applied at the end of the step and bdy_dta_tides is referenced at the middle of the step 
    353344            CALL bdy_dta_tides( kt=kt, pt_offset = 1._wp ) 
    354345         ENDIF 
    … …  
    358349      ! 
    359350   END SUBROUTINE bdy_dta 
    360  
     351    
    361352 
    362353   SUBROUTINE bdy_dta_init 
    … …  
    390381      LOGICAL                                ::   llneed        ! 
    391382      LOGICAL                                ::   llread        ! 
     383      LOGICAL                                ::   llfullbdy     ! 
    392384      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_tem, bn_sal, bn_u3d, bn_v3d   ! must be an array to be used with fld_fill 
    393385      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
    … …  
    504496               igrd = 2                                                    ! U point 
    505497               ipk = 1                                                     ! surface data 
    506                llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed 
     498               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%u2d will be needed 
    507499               llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get u2d from u3d and read NetCDF file 
    508500               bf_alias => bf(jp_bdyu2d,jbdy:jbdy)                         ! alias for u2d structure of bdy number jbdy 
    509501               bn_alias => bn_u2d                                          ! alias for u2d structure of nambdy_dta 
    510                IF( ln_full_vel ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)      ! will be computed from u3d -> need on the full bdy 
    511                ELSE                    ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)   ! used only on the rim 
     502               llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs'        ! need u2d over the whole bdy or only over the rim? 
     503               IF( llfullbdy ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd) 
     504               ELSE                  ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd) 
    512505               ENDIF 
    513506            ENDIF 
    … …  
    516509               igrd = 3                                                    ! V point 
    517510               ipk = 1                                                     ! surface data 
    518                llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed 
     511               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%v2d will be needed 
    519512               llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get v2d from v3d and read NetCDF file 
    520513               bf_alias => bf(jp_bdyv2d,jbdy:jbdy)                         ! alias for v2d structure of bdy number jbdy 
    521514               bn_alias => bn_v2d                                          ! alias for v2d structure of nambdy_dta  
    522                IF( ln_full_vel ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)      ! will be computed from v3d -> need on the full bdy 
    523                ELSE                    ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)   ! used only on the rim 
     515               llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs'        ! need v2d over the whole bdy or only over the rim? 
     516               IF( llfullbdy ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd) 
     517               ELSE                  ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd) 
    524518               ENDIF 
    525519            ENDIF 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/BDY/bdyini.F90

    r12546 r13135  
    1919   USE oce            ! ocean dynamics and tracers variables 
    2020   USE dom_oce        ! ocean space and time domain 
     21   USE sbc_oce , ONLY: nn_ice 
    2122   USE bdy_oce        ! unstructured open boundary conditions 
    2223   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine) 
    2324   USE bdytides       ! open boundary cond. setting   (bdytide_init routine) 
    2425   USE tide_mod, ONLY: ln_tide ! tidal forcing 
    25    USE phycst   , ONLY: rday 
     26   USE phycst  , ONLY: rday 
    2627   ! 
    2728   USE in_out_manager ! I/O units 
    … …  
    315316 
    316317         dta_bdy(ib_bdy)%lneed_ice = cn_ice(ib_bdy) /= 'none' 
     318 
     319         IF( dta_bdy(ib_bdy)%lneed_ice .AND. nn_ice /= 2 ) THEN 
     320            WRITE(ctmp1,*) 'bdy number ', ib_bdy,', needs ice model but nn_ice = ', nn_ice 
     321            CALL ctl_stop( ctmp1 ) 
     322         ENDIF 
    317323 
    318324         IF( lwp .AND. dta_bdy(ib_bdy)%lneed_ice ) THEN  

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/BDY/bdytides.F90

    r12489 r13135  
    6565      !! namelist variables 
    6666      !!------------------- 
    67       CHARACTER(len=80)                         ::   filtide             !: Filename root for tidal input files 
    68       LOGICAL                                   ::   ln_bdytide_2ddta    !: If true, read 2d harmonic data 
     67      CHARACTER(len=80)                         ::   filtide             ! Filename root for tidal input files 
     68      LOGICAL                                   ::   ln_bdytide_2ddta    ! If true, read 2d harmonic data 
    6969      !! 
    70       INTEGER                                   ::   ib_bdy, itide, ib   !: dummy loop indices 
    71       INTEGER                                   ::   ii, ij              !: dummy loop indices 
     70      INTEGER                                   ::   ib_bdy, itide, ib   ! dummy loop indices 
     71      INTEGER                                   ::   ii, ij              ! dummy loop indices 
    7272      INTEGER                                   ::   inum, igrd 
    73       INTEGER, DIMENSION(3)                     ::   ilen0       !: length of boundary data (from OBC arrays) 
     73      INTEGER                                   ::   isz                 ! bdy data size 
    7474      INTEGER                                   ::   ios                 ! Local integer output status for namelist read 
    7575      INTEGER                                   ::   nbdy_rdstart, nbdy_loc 
    76       CHARACTER(LEN=50)                         ::   cerrmsg             !: error string 
    77       CHARACTER(len=80)                         ::   clfile              !: full file name for tidal input file  
    78       REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            !: work space to read in tidal harmonics data 
    79       REAL(wp),ALLOCATABLE, DIMENSION(:,:)      ::   ztr, zti            !:  "     "    "   "   "   "        "      "  
     76      CHARACTER(LEN=50)                         ::   cerrmsg             ! error string 
     77      CHARACTER(len=80)                         ::   clfile              ! full file name for tidal input file  
     78      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            ! work space to read in tidal harmonics data 
     79      REAL(wp),ALLOCATABLE, DIMENSION(:,:)      ::   ztr, zti            !  "     "    "   "   "   "        "      "  
    8080      !! 
    81       TYPE(TIDES_DATA),  POINTER                ::   td                  !: local short cut    
     81      TYPE(TIDES_DATA), POINTER                 ::   td                  ! local short cut    
     82      TYPE(  OBC_DATA), POINTER                 ::   dta                 ! local short cut 
    8283      !! 
    8384      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta 
    … …  
    9394         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
    9495            ! 
    95             td => tides(ib_bdy) 
    96  
     96            td  => tides(ib_bdy) 
     97            dta => dta_bdy(ib_bdy) 
     98          
    9799            ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 
    98100            filtide(:) = '' 
    … …  
    130132            IF(lwp) WRITE(numout,*) ' ' 
    131133 
    132             ! Allocate space for tidal harmonics data - get size from OBC data arrays 
     134            ! Allocate space for tidal harmonics data - get size from BDY data arrays 
     135            ! Allocate also slow varying data in the case of time splitting: 
     136            ! Do it anyway because at this stage knowledge of free surface scheme is unknown 
    133137            ! ----------------------------------------------------------------------- 
    134  
    135             ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 
    136             ! relaxation area       
    137             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = idx_bdy(ib_bdy)%nblen   (:) 
    138             ELSE                                   ;   ilen0(:) = idx_bdy(ib_bdy)%nblenrim(:) 
    139             ENDIF 
    140  
    141             ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) ) 
    142             ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) ) 
    143  
    144             ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) ) 
    145             ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) ) 
    146  
    147             ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) ) 
    148             ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) ) 
    149  
    150             td%ssh0(:,:,:) = 0._wp 
    151             td%ssh (:,:,:) = 0._wp 
    152             td%u0  (:,:,:) = 0._wp 
    153             td%u   (:,:,:) = 0._wp 
    154             td%v0  (:,:,:) = 0._wp 
    155             td%v   (:,:,:) = 0._wp 
    156  
     138            IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain 
     139               isz = SIZE(dta%ssh) 
     140               ALLOCATE( td%ssh0( isz, nb_harmo, 2 ), td%ssh( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%ssh( isz ) ) 
     141               dta_bdy_s(ib_bdy)%ssh(:) = 0._wp   ! needed? 
     142            ENDIF 
     143            IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain 
     144               isz = SIZE(dta%u2d) 
     145               ALLOCATE( td%u0  ( isz, nb_harmo, 2 ), td%u  ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%u2d( isz ) ) 
     146               dta_bdy_s(ib_bdy)%u2d(:) = 0._wp   ! needed? 
     147            ENDIF 
     148            IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain 
     149               isz = SIZE(dta%v2d) 
     150               ALLOCATE( td%v0  ( isz, nb_harmo, 2 ), td%v  ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%v2d( isz ) ) 
     151               dta_bdy_s(ib_bdy)%v2d(:) = 0._wp   ! needed? 
     152            ENDIF 
     153 
     154            ! fill td%ssh0, td%u0, td%v0 
     155            ! ----------------------------------------------------------------------- 
    157156            IF( ln_bdytide_2ddta ) THEN 
     157               ! 
    158158               ! It is assumed that each data file contains all complex harmonic amplitudes 
    159159               ! given on the global domain (ie global, jpiglo x jpjglo) 
    … …  
    162162               ! 
    163163               ! SSH fields 
    164                clfile = TRIM(filtide)//'_grid_T.nc' 
    165                CALL iom_open( clfile , inum )  
    166                igrd = 1                       ! Everything is at T-points here 
    167                DO itide = 1, nb_harmo 
    168                   CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 
    169                   CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )  
    170                   DO ib = 1, ilen0(igrd) 
    171                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    172                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    173                      IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    174                      td%ssh0(ib,itide,1) = ztr(ii,ij) 
    175                      td%ssh0(ib,itide,2) = zti(ii,ij) 
    176                   END DO 
    177                END DO  
    178                CALL iom_close( inum ) 
     164               IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain 
     165                  clfile = TRIM(filtide)//'_grid_T.nc' 
     166                  CALL iom_open( clfile , inum )  
     167                  igrd = 1                       ! Everything is at T-points here 
     168                  DO itide = 1, nb_harmo 
     169                     CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 
     170                     CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )  
     171                     DO ib = 1, SIZE(dta%ssh) 
     172                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     173                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     174                        td%ssh0(ib,itide,1) = ztr(ii,ij) 
     175                        td%ssh0(ib,itide,2) = zti(ii,ij) 
     176                     END DO 
     177                  END DO 
     178                  CALL iom_close( inum ) 
     179               ENDIF 
    179180               ! 
    180181               ! U fields 
    181                clfile = TRIM(filtide)//'_grid_U.nc' 
    182                CALL iom_open( clfile , inum )  
    183                igrd = 2                       ! Everything is at U-points here 
    184                DO itide = 1, nb_harmo 
    185                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 
    186                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 
    187                   DO ib = 1, ilen0(igrd) 
    188                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    189                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    190                      IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    191                      td%u0(ib,itide,1) = ztr(ii,ij) 
    192                      td%u0(ib,itide,2) = zti(ii,ij) 
    193                   END DO 
    194                END DO 
    195                CALL iom_close( inum ) 
     182               IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain 
     183                  clfile = TRIM(filtide)//'_grid_U.nc' 
     184                  CALL iom_open( clfile , inum )  
     185                  igrd = 2                       ! Everything is at U-points here 
     186                  DO itide = 1, nb_harmo 
     187                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 
     188                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 
     189                     DO ib = 1, SIZE(dta%u2d) 
     190                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     191                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     192                        td%u0(ib,itide,1) = ztr(ii,ij) 
     193                        td%u0(ib,itide,2) = zti(ii,ij) 
     194                     END DO 
     195                  END DO 
     196                  CALL iom_close( inum ) 
     197               ENDIF 
    196198               ! 
    197199               ! V fields 
    198                clfile = TRIM(filtide)//'_grid_V.nc' 
    199                CALL iom_open( clfile , inum )  
    200                igrd = 3                       ! Everything is at V-points here 
    201                DO itide = 1, nb_harmo 
    202                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 
    203                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 
    204                   DO ib = 1, ilen0(igrd) 
    205                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    206                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    207                      IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    208                      td%v0(ib,itide,1) = ztr(ii,ij) 
    209                      td%v0(ib,itide,2) = zti(ii,ij) 
    210                   END DO 
    211                END DO   
    212                CALL iom_close( inum ) 
     200               IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain 
     201                  clfile = TRIM(filtide)//'_grid_V.nc' 
     202                  CALL iom_open( clfile , inum )  
     203                  igrd = 3                       ! Everything is at V-points here 
     204                  DO itide = 1, nb_harmo 
     205                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 
     206                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 
     207                     DO ib = 1, SIZE(dta%v2d) 
     208                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     209                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     210                        td%v0(ib,itide,1) = ztr(ii,ij) 
     211                        td%v0(ib,itide,2) = zti(ii,ij) 
     212                     END DO 
     213                  END DO 
     214                  CALL iom_close( inum ) 
     215               ENDIF 
    213216               ! 
    214217               DEALLOCATE( ztr, zti )  
    … …  
    218221               ! Read tidal data only on bdy segments 
    219222               !  
    220                ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) ) 
     223               ALLOCATE( dta_read( MAXVAL( idx_bdy(ib_bdy)%nblen(:) ), 1, 1 ) ) 
    221224               ! 
    222225               ! Open files and read in tidal forcing data 
    … …  
    225228               DO itide = 1, nb_harmo 
    226229                  !                                                              ! SSH fields 
    227                   clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 
    228                   CALL iom_open( clfile, inum ) 
    229                   CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
    230                   td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1) 
    231                   CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
    232                   td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1) 
    233                   CALL iom_close( inum ) 
     230                  IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain 
     231                     isz = SIZE(dta%ssh) 
     232                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 
     233                     CALL iom_open( clfile, inum ) 
     234                     CALL fld_map( inum, 'z1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
     235                     td%ssh0(:,itide,1) = dta_read(1:isz,1,1) 
     236                     CALL fld_map( inum, 'z2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
     237                     td%ssh0(:,itide,2) = dta_read(1:isz,1,1) 
     238                     CALL iom_close( inum ) 
     239                  ENDIF 
    234240                  !                                                              ! U fields 
    235                   clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 
    236                   CALL iom_open( clfile, inum ) 
    237                   CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
    238                   td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1) 
    239                   CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
    240                   td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1) 
    241                   CALL iom_close( inum ) 
     241                  IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain 
     242                     isz = SIZE(dta%u2d) 
     243                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 
     244                     CALL iom_open( clfile, inum ) 
     245                     CALL fld_map( inum, 'u1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
     246                     td%u0(:,itide,1) = dta_read(1:isz,1,1) 
     247                     CALL fld_map( inum, 'u2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
     248                     td%u0(:,itide,2) = dta_read(1:isz,1,1) 
     249                     CALL iom_close( inum ) 
     250                  ENDIF 
    242251                  !                                                              ! V fields 
    243                   clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 
    244                   CALL iom_open( clfile, inum ) 
    245                   CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
    246                   td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1) 
    247                   CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
    248                   td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1) 
    249                   CALL iom_close( inum ) 
     252                  IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain 
     253                     isz = SIZE(dta%v2d) 
     254                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 
     255                     CALL iom_open( clfile, inum ) 
     256                     CALL fld_map( inum, 'v1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
     257                     td%v0(:,itide,1) = dta_read(1:isz,1,1) 
     258                     CALL fld_map( inum, 'v2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
     259                     td%v0(:,itide,2) = dta_read(1:isz,1,1) 
     260                     CALL iom_close( inum ) 
     261                  ENDIF 
    250262                  ! 
    251263               END DO ! end loop on tidal components 
    … …  
    254266               ! 
    255267            ENDIF ! ln_bdytide_2ddta=.true. 
    256             ! 
    257             ! Allocate slow varying data in the case of time splitting: 
    258             ! Do it anyway because at this stage knowledge of free surface scheme is unknown 
    259             ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) ) 
    260             ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) ) 
    261             ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) ) 
    262             dta_bdy_s(ib_bdy)%ssh(:) = 0._wp 
    263             dta_bdy_s(ib_bdy)%u2d(:) = 0._wp 
    264             dta_bdy_s(ib_bdy)%v2d(:) = 0._wp 
    265268            ! 
    266269         ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2 
    … …  
    283286      ! 
    284287      LOGICAL  ::   lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step 
    285       INTEGER  ::   itide, ib_bdy, ib, igrd   ! loop indices 
    286       INTEGER, DIMENSION(jpbgrd)   ::   ilen0  
    287       INTEGER, DIMENSION(1:jpbgrd) ::   nblen, nblenrim  ! short cuts 
     288      INTEGER  ::   itide, ib_bdy, ib         ! loop indices 
    288289      REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist, zt_offset    
    289290      !!---------------------------------------------------------------------- 
    … …  
    310311         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
    311312            ! 
    312             nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd) 
    313             nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd) 
    314             ! 
    315             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:) 
    316             ELSE                                   ;   ilen0(:) = nblenrim(:) 
    317             ENDIF      
    318             ! 
    319313            ! We refresh nodal factors every day below 
    320314            ! This should be done somewhere else 
    … …  
    337331            ! If time splitting, initialize arrays from slow varying open boundary data: 
    338332            IF ( PRESENT(kit) ) THEN            
    339                IF ( dta_bdy(ib_bdy)%lneed_ssh   ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
    340                IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
    341                IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
     333               IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) dta_bdy(ib_bdy)%ssh(:) = dta_bdy_s(ib_bdy)%ssh(:) 
     334               IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) dta_bdy(ib_bdy)%u2d(:) = dta_bdy_s(ib_bdy)%u2d(:) 
     335               IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) dta_bdy(ib_bdy)%v2d(:) = dta_bdy_s(ib_bdy)%v2d(:) 
    342336            ENDIF 
    343337            ! 
    … …  
    349343               z_sist = zramp * SIN( z_sarg ) 
    350344               ! 
    351                IF ( dta_bdy(ib_bdy)%lneed_ssh ) THEN 
    352                   igrd=1                              ! SSH on tracer grid 
    353                   DO ib = 1, ilen0(igrd) 
     345               IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) THEN   ! SSH on tracer grid 
     346                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%ssh) 
    354347                     dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + & 
    355348                        &                      ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + & 
    … …  
    358351               ENDIF 
    359352               ! 
    360                IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) THEN 
    361                   igrd=2                              ! U grid 
    362                   DO ib = 1, ilen0(igrd) 
     353               IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) THEN  ! U grid 
     354                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%u2d) 
    363355                     dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + & 
    364356                        &                      ( tides(ib_bdy)%u(ib,itide,1)*z_cost + & 
    365357                        &                        tides(ib_bdy)%u(ib,itide,2)*z_sist ) 
    366358                  END DO 
    367                   igrd=3                              ! V grid 
    368                   DO ib = 1, ilen0(igrd)  
     359               ENDIF 
     360               ! 
     361               IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) THEN   ! V grid 
     362                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%v2d) 
    369363                     dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + & 
    370364                        &                      ( tides(ib_bdy)%v(ib,itide,1)*z_cost + & 
    … …  
    372366                  END DO 
    373367               ENDIF 
     368               ! 
    374369            END DO              
    375          END IF 
     370         ENDIF 
    376371      END DO 
    377372      ! 
    … …  
    386381      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data 
    387382      ! 
    388       INTEGER ::   itide, igrd, ib       ! dummy loop indices 
    389       INTEGER, DIMENSION(1) ::   ilen0   ! length of boundary data (from OBC arrays) 
     383      INTEGER ::   itide, isz, ib       ! dummy loop indices 
    390384      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide 
    391385      !!---------------------------------------------------------------------- 
    392386      ! 
    393       igrd=1    
    394                               ! SSH on tracer grid. 
    395       ilen0(1) =  SIZE(td%ssh0(:,1,1)) 
    396       ! 
    397       ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) ) 
    398       ! 
    399       DO itide = 1, nb_harmo 
    400          DO ib = 1, ilen0(igrd) 
    401             mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)**2.+td%ssh0(ib,itide,2)**2.) 
    402             phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 
     387      IF( ASSOCIATED(td%ssh0) ) THEN   ! SSH on tracer grid. 
     388         ! 
     389         isz = SIZE( td%ssh0, dim = 1 ) 
     390         ALLOCATE( mod_tide(isz), phi_tide(isz) ) 
     391         ! 
     392         DO itide = 1, nb_harmo 
     393            DO ib = 1, isz 
     394               mod_tide(ib)=SQRT( td%ssh0(ib,itide,1)*td%ssh0(ib,itide,1) + td%ssh0(ib,itide,2)*td%ssh0(ib,itide,2) ) 
     395               phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 
     396            END DO 
     397            DO ib = 1, isz 
     398               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
     399               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 
     400            END DO 
     401            DO ib = 1, isz 
     402               td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
     403               td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
     404            END DO 
    403405         END DO 
    404          DO ib = 1 , ilen0(igrd) 
    405             mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
    406             phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 
    407          ENDDO 
    408          DO ib = 1 , ilen0(igrd) 
    409             td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
    410             td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
    411          ENDDO 
    412       END DO 
    413       ! 
    414       DEALLOCATE( mod_tide, phi_tide ) 
     406         ! 
     407         DEALLOCATE( mod_tide, phi_tide ) 
     408         ! 
     409      ENDIF 
    415410      ! 
    416411   END SUBROUTINE tide_init_elevation 
    … …  
    424419      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data 
    425420      ! 
    426       INTEGER ::   itide, igrd, ib       ! dummy loop indices 
    427       INTEGER, DIMENSION(3) ::   ilen0   ! length of boundary data (from OBC arrays) 
     421      INTEGER ::   itide, isz, ib        ! dummy loop indices 
    428422      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide 
    429423      !!---------------------------------------------------------------------- 
    430424      ! 
    431       ilen0(2) =  SIZE(td%u0(:,1,1)) 
    432       ilen0(3) =  SIZE(td%v0(:,1,1)) 
    433       ! 
    434       igrd=2                                 ! U grid. 
    435       ! 
    436       ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 
    437       ! 
    438       DO itide = 1, nb_harmo 
    439          DO ib = 1, ilen0(igrd) 
    440             mod_tide(ib)=SQRT(td%u0(ib,itide,1)**2.+td%u0(ib,itide,2)**2.) 
    441             phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 
     425      IF( ASSOCIATED(td%u0) ) THEN   ! U grid. we use bdy u2d on this mpi subdomain 
     426         ! 
     427         isz = SIZE( td%u0, dim = 1 ) 
     428         ALLOCATE( mod_tide(isz), phi_tide(isz) ) 
     429         ! 
     430         DO itide = 1, nb_harmo 
     431            DO ib = 1, isz 
     432               mod_tide(ib)=SQRT( td%u0(ib,itide,1)*td%u0(ib,itide,1) + td%u0(ib,itide,2)*td%u0(ib,itide,2) ) 
     433               phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 
     434            END DO 
     435            DO ib = 1, isz 
     436               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
     437               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
     438            END DO 
     439            DO ib = 1, isz 
     440               td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
     441               td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
     442            END DO 
    442443         END DO 
    443          DO ib = 1, ilen0(igrd) 
    444             mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
    445             phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
    446          ENDDO 
    447          DO ib = 1, ilen0(igrd) 
    448             td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
    449             td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
    450          ENDDO 
    451       END DO 
    452       ! 
    453       DEALLOCATE( mod_tide , phi_tide ) 
    454       ! 
    455       igrd=3                                 ! V grid. 
    456       ! 
    457       ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 
    458  
    459       DO itide = 1, nb_harmo 
    460          DO ib = 1, ilen0(igrd) 
    461             mod_tide(ib)=SQRT(td%v0(ib,itide,1)**2.+td%v0(ib,itide,2)**2.) 
    462             phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 
     444         ! 
     445         DEALLOCATE( mod_tide, phi_tide ) 
     446         ! 
     447      ENDIF 
     448      ! 
     449      IF( ASSOCIATED(td%v0) ) THEN   ! V grid. we use bdy u2d on this mpi subdomain 
     450         ! 
     451         isz = SIZE( td%v0, dim = 1 ) 
     452         ALLOCATE( mod_tide(isz), phi_tide(isz) ) 
     453         ! 
     454         DO itide = 1, nb_harmo 
     455            DO ib = 1, isz 
     456               mod_tide(ib)=SQRT( td%v0(ib,itide,1)*td%v0(ib,itide,1) + td%v0(ib,itide,2)*td%v0(ib,itide,2) ) 
     457               phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 
     458            END DO 
     459            DO ib = 1, isz 
     460               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
     461               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
     462            END DO 
     463            DO ib = 1, isz 
     464               td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
     465               td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
     466            END DO 
    463467         END DO 
    464          DO ib = 1, ilen0(igrd) 
    465             mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
    466             phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
    467          ENDDO 
    468          DO ib = 1, ilen0(igrd) 
    469             td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
    470             td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
    471          ENDDO 
    472       END DO 
    473       ! 
    474       DEALLOCATE( mod_tide, phi_tide ) 
    475       ! 
    476   END SUBROUTINE tide_init_velocities 
     468         ! 
     469         DEALLOCATE( mod_tide, phi_tide ) 
     470         ! 
     471      ENDIF 
     472      ! 
     473   END SUBROUTINE tide_init_velocities 
    477474 
    478475   !!====================================================================== 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/C1D/step_c1d.F90

    r12377 r13135  
    2727   PRIVATE 
    2828 
    29    PUBLIC stp_c1d      ! called by opa.F90 
     29   PUBLIC stp_c1d      ! called by nemogcm.F90 
    3030 
    3131   !!---------------------------------------------------------------------- 
    … …  
    5656      ! 
    5757      INTEGER ::   jk       ! dummy loop indice 
    58       INTEGER ::   indic    ! error indicator if < 0 
    5958      !! --------------------------------------------------------------------- 
    60  
    61                              indic = 0                ! reset to no error condition 
    6259      IF( kstp == nit000 )   CALL iom_init( "nemo")   ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    6360      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init) 
    … …  
    8885      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    8986                         CALL dia_wri( kstp, Nnn )  ! ocean model: outputs 
    90       IF( lk_diahth  )   CALL dia_hth( kstp, Nnn )  ! Thermocline depth (20°C) 
     87                         CALL dia_hth( kstp, Nnn )  ! Thermocline depth (20°C) 
    9188 
    9289 
    … …  
    111108                        CALL eos( ts(:,:,:,:,Nnn), rhd, rhop, gdept_0(:,:,:) )  ! now potential density for zdfmxl 
    112109      IF( ln_zdfnpc )   CALL tra_npc( kstp,      Nnn, Nrhs, ts, Naa   )         ! applied non penetrative convective adjustment on (t,s) 
    113                         CALL tra_atf( kstp, Nbb, Nnn, Nrhs,     Naa, ts   )     ! time filtering of "now" tracer fields 
    114  
    115  
     110                        CALL tra_atf( kstp, Nbb, Nnn, Naa, ts )                 ! time filtering of "now" tracer arrays 
    116111 
    117112      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    139134      ! Control and restarts 
    140135      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    141                              CALL stp_ctl( kstp, Nnn, indic ) 
     136                             CALL stp_ctl( kstp, Nnn ) 
    142137      IF( kstp == nit000 )   CALL iom_close( numror )          ! close input  ocean restart file 
    143138      IF( lrst_oce       )   CALL rst_write( kstp, Nbb, Nnn )  ! write output ocean restart file 
    144139      ! 
    145140#if defined key_iomput 
    146       IF( kstp == nitend .OR. indic < 0 )   CALL xios_context_finalize()   ! needed for XIOS 
     141      IF( kstp == nitend .OR. nstop > 0 )   CALL xios_context_finalize()   ! needed for XIOS 
    147142      ! 
    148143#endif 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DIA/diaar5.F90

    r12546 r13135  
    3232   REAL(wp)                         ::   vol0         ! ocean volume (interior domain) 
    3333   REAL(wp)                         ::   area_tot     ! total ocean surface (interior domain) 
    34    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   area         ! cell surface (interior domain) 
    3534   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain) 
    3635   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity 
    … …  
    5453      !!---------------------------------------------------------------------- 
    5554      ! 
    56       ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 
     55      ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 
    5756      ! 
    5857      CALL mpp_sum ( 'diaar5', dia_ar5_alloc ) 
    … …  
    7877      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace  
    7978      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zpe, z2d                   ! 2D workspace  
    80       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: zrhd , zrhop, ztpot   ! 3D workspace 
     79      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: zrhd , ztpot               ! 3D workspace 
    8180      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace 
    8281 
    … …  
    8887      IF( l_ar5 ) THEN  
    8988         ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) ) 
    90          ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 
     89         ALLOCATE( zrhd(jpi,jpj,jpk) ) 
    9190         ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 
    92          zarea_ssh(:,:) = area(:,:) * ssh(:,:,Kmm) 
    93       ENDIF 
    94       ! 
    95       CALL iom_put( 'e2u'      , e2u (:,:) ) 
    96       CALL iom_put( 'e1v'      , e1v (:,:) ) 
    97       CALL iom_put( 'areacello', area(:,:) ) 
     91         zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm) 
     92      ENDIF 
     93      ! 
     94      CALL iom_put( 'e2u'      , e2u  (:,:) ) 
     95      CALL iom_put( 'e1v'      , e1v  (:,:) ) 
     96      CALL iom_put( 'areacello', e1e2t(:,:) ) 
    9897      ! 
    9998      IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' )  ) THEN   
    10099         zrhd(:,:,jpk) = 0._wp        ! ocean volume ; rhd is used as workspace 
    101100         DO jk = 1, jpkm1 
    102             zrhd(:,:,jk) = area(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
     101            zrhd(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    103102         END DO 
    104103         CALL iom_put( 'volcello'  , zrhd(:,:,:)  )  ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 
    … …  
    151150         END IF 
    152151         !                                          
    153          zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) )  
     152         zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) )  
    154153         zssh_steric = - zarho / area_tot 
    155154         CALL iom_put( 'sshthster', zssh_steric ) 
    156155       
    157156         !                                         ! steric sea surface height 
    158          CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, gdept(:,:,:,Kmm) )                 ! now in situ and potential density 
    159          zrhop(:,:,jpk) = 0._wp 
    160          CALL iom_put( 'rhop', zrhop ) 
    161          ! 
    162157         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    163158         DO jk = 1, jpkm1 
    164             zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk) 
     159            zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * rhd(:,:,jk) 
    165160         END DO 
    166161         IF( ln_linssh ) THEN 
    … …  
    169164                  DO jj = 1,jpj 
    170165                     iks = mikt(ji,jj) 
    171                      zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) 
     166                     zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,iks) + riceload(ji,jj) 
    172167                  END DO 
    173168               END DO 
    174169            ELSE 
    175                zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) 
     170               zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * rhd(:,:,1) 
    176171            END IF 
    177172         END IF 
    178173         !     
    179          zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) )  
     174         zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) )  
    180175         zssh_steric = - zarho / area_tot 
    181176         CALL iom_put( 'sshsteric', zssh_steric ) 
    … …  
    191186          ztsn(:,:,:,:) = 0._wp                    ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity 
    192187          DO_3D_11_11( 1, jpkm1 ) 
    193              zztmp = area(ji,jj) * e3t(ji,jj,jk,Kmm) 
     188             zztmp = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) 
    194189             ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm) 
    195190             ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm) 
    … …  
    237232               z2d(:,:) = 0._wp 
    238233               DO jk = 1, jpkm1 
    239                  z2d(:,:) = z2d(:,:) + area(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) 
     234                 z2d(:,:) = z2d(:,:) + e1e2t(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) 
    240235               END DO 
    241236               ztemp = glob_sum( 'diaar5', z2d(:,:)  )  
    … …  
    244239             ! 
    245240             IF( iom_use( 'ssttot' ) ) THEN   ! Output potential temperature in case we use TEOS-10 
    246                zsst = glob_sum( 'diaar5',  area(:,:) * ztpot(:,:,1)  )  
     241               zsst = glob_sum( 'diaar5',  e1e2t(:,:) * ztpot(:,:,1)  )  
    247242               CALL iom_put( 'ssttot', zsst / area_tot ) 
    248243             ENDIF 
    … …  
    259254      ELSE        
    260255         IF( iom_use('ssttot') ) THEN   ! Output sst in case we use EOS-80 
    261             zsst  = glob_sum( 'diaar5', area(:,:) * ts(:,:,1,jp_tem,Kmm) ) 
     256            zsst  = glob_sum( 'diaar5', e1e2t(:,:) * ts(:,:,1,jp_tem,Kmm) ) 
    262257            CALL iom_put('ssttot', zsst / area_tot ) 
    263258         ENDIF 
    … …  
    294289      IF( l_ar5 ) THEN 
    295290        DEALLOCATE( zarea_ssh , zbotpres, z2d ) 
    296         DEALLOCATE( zrhd      , zrhop    ) 
    297291        DEALLOCATE( ztsn                 ) 
    298292      ENDIF 
    … …  
    368362      IF(   iom_use( 'voltot'  ) .OR. iom_use( 'sshtot'    )  .OR. iom_use( 'sshdyn' )  .OR.  &  
    369363         &  iom_use( 'masstot' ) .OR. iom_use( 'temptot'   )  .OR. iom_use( 'saltot' ) .OR.  &     
    370          &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) L_ar5 = .TRUE. 
     364         &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' ) .OR. & 
     365         &  iom_use( 'rhop' )  ) L_ar5 = .TRUE. 
    371366   
    372367      IF( l_ar5 ) THEN 
    … …  
    375370         IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
    376371 
    377          area(:,:) = e1e2t(:,:) 
    378          area_tot  = glob_sum( 'diaar5', area(:,:) ) 
     372         area_tot  = glob_sum( 'diaar5', e1e2t(:,:) ) 
    379373 
    380374         ALLOCATE( zvol0(jpi,jpj) ) 
    … …  
    383377         DO_3D_11_11( 1, jpkm1 ) 
    384378            idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
    385             zvol0 (ji,jj) = zvol0 (ji,jj) +  idep * area(ji,jj) 
     379            zvol0 (ji,jj) = zvol0 (ji,jj) +  idep * e1e2t(ji,jj) 
    386380            thick0(ji,jj) = thick0(ji,jj) +  idep     
    387381         END_3D 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DIA/diamlr.F90

    r12377 r13135  
    8484      INTEGER                                     ::   itide                       ! Number of available tidal components 
    8585      REAL(wp)                                    ::   ztide_phase                 ! Tidal-constituent phase at adatrj=0 
    86       CHARACTER (LEN=4), DIMENSION(jpmax_harmo)   ::   ctide_selected = ' n/a ' 
     86      CHARACTER (LEN=4), DIMENSION(jpmax_harmo)   ::   ctide_selected = 'n/a ' 
    8787      TYPE(tide_harmonic), DIMENSION(:), POINTER  ::   stideconst 
    8888 
    … …  
    145145            ! Retrieve information (frequency, phase, nodal correction) about all 
    146146            ! available tidal constituents for placeholder substitution below 
    147             ctide_selected(1:34) = (/ 'Mf', 'Mm', 'Ssa', 'Mtm', 'Msf',    & 
    148                &                      'Msqm', 'Sa', 'K1', 'O1', 'P1',     & 
    149                &                      'Q1', 'J1', 'S1', 'M2', 'S2', 'N2', & 
    150                &                      'K2', 'nu2', 'mu2', '2N2', 'L2',    & 
    151                &                      'T2', 'eps2', 'lam2', 'R2', 'M3',   & 
    152                &                      'MKS2', 'MN4', 'MS4', 'M4', 'N4',   & 
    153                &                      'S4', 'M6', 'M8' /) 
     147            ! Warning: we must use the same character length in an array constructor (at least for gcc compiler) 
     148            ctide_selected(1:34) = (/ 'Mf  ', 'Mm  ', 'Ssa ', 'Mtm ', 'Msf ',         & 
     149               &                      'Msqm', 'Sa  ', 'K1  ', 'O1  ', 'P1  ',         & 
     150               &                      'Q1  ', 'J1  ', 'S1  ', 'M2  ', 'S2  ', 'N2  ', & 
     151               &                      'K2  ', 'nu2 ', 'mu2 ', '2N2 ', 'L2  ',         & 
     152               &                      'T2  ', 'eps2', 'lam2', 'R2  ', 'M3  ',         & 
     153               &                      'MKS2', 'MN4 ', 'MS4 ', 'M4  ', 'N4  ',         & 
     154               &                      'S4  ', 'M6  ', 'M8  ' /) 
    154155            CALL tide_init_harmonics(ctide_selected, stideconst) 
    155156            itide = size(stideconst) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DIA/diawri.F90

    r12546 r13135  
    171171         CALL iom_put( "sbs", z2d )                ! bottom salinity 
    172172      ENDIF 
     173 
     174      CALL iom_put( "rhop", rhop(:,:,:) )          ! 3D potential density (sigma0) 
    173175 
    174176      IF ( iom_use("taubot") ) THEN                ! bottom stress 
    … …  
    924926      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    925927      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
    926  
    927 #if defined key_si3 
    928      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
    929 #else 
    930      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
    931 #endif 
    932  
     928      ! 
     929      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
     930      ! 
    933931      CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) )    ! now temperature 
    934932      CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) )    ! now salinity 
    … …  
    943941      CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep            )    ! now k-velocity 
    944942      CALL iom_rstput( 0, 0, inum, 'ht'     , ht                 )    ! now water column height 
    945  
     943      ! 
    946944      IF ( ln_isf ) THEN 
    947945         IF (ln_isfcav_mlt) THEN 
    … …  
    949947            CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav    )    ! now k-velocity 
    950948            CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav    )    ! now k-velocity 
    951             CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,8)    )    ! now k-velocity 
    952             CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,8)    )    ! now k-velocity 
    953             CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,8), ktype = jp_i1 ) 
     949            CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,wp) )    ! now k-velocity 
     950            CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,wp) )    ! now k-velocity 
     951            CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,wp), ktype = jp_i1 ) 
    954952         END IF 
    955953         IF (ln_isfpar_mlt) THEN 
    956             CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,8) )    ! now k-velocity 
     954            CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,wp) )    ! now k-velocity 
    957955            CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par          )    ! now k-velocity 
    958956            CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par    )    ! now k-velocity 
    959957            CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par    )    ! now k-velocity 
    960             CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,8)    )    ! now k-velocity 
    961             CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,8)    )    ! now k-velocity 
    962             CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,8), ktype = jp_i1 ) 
     958            CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,wp) )    ! now k-velocity 
     959            CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,wp) )    ! now k-velocity 
     960            CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,wp), ktype = jp_i1 ) 
    963961         END IF 
    964962      END IF 
    965  
     963      ! 
    966964      IF( ALLOCATED(ahtu) ) THEN 
    967965         CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point 
    … …  
    993991         CALL iom_rstput ( 0, 0, inum, "qz1_abl",  tq_abl(:,:,2,nt_a,2) )   ! now first level humidity 
    994992      ENDIF 
    995   
     993      ! 
     994      CALL iom_close( inum ) 
     995      !  
    996996#if defined key_si3 
    997997      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
     998         CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    998999         CALL ice_wri_state( inum ) 
    999       ENDIF 
     1000         CALL iom_close( inum ) 
     1001      ENDIF 
     1002      ! 
    10001003#endif 
    1001       ! 
    1002       CALL iom_close( inum ) 
    1003       !  
    10041004   END SUBROUTINE dia_wri_state 
    10051005 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DOM/dom_oce.F90

    r12489 r13135  
    1717   !!---------------------------------------------------------------------- 
    1818   !!   Agrif_Root    : dummy function used when lk_agrif=F 
     19   !!   Agrif_Fixed   : dummy function used when lk_agrif=F 
    1920   !!   Agrif_CFixed  : dummy function used when lk_agrif=F 
    2021   !!   dom_oce_alloc : dynamical allocation of dom_oce arrays 
    … …  
    233234   END FUNCTION Agrif_Root 
    234235 
     236   INTEGER FUNCTION Agrif_Fixed() 
     237      Agrif_Fixed = 0 
     238   END FUNCTION Agrif_Fixed 
     239 
    235240   CHARACTER(len=3) FUNCTION Agrif_CFixed() 
    236241      Agrif_CFixed = '0'  

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DOM/dommsk.F90

    r12546 r13135  
    259259               ENDIF 
    260260            END DO 
    261 #if defined key_agrif  
    262             IF( .NOT. AGRIF_Root() ) THEN  
    263                IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east  
    264                IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west  
    265                IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north  
    266                IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south  
    267             ENDIF  
    268 #endif  
    269261         END DO 
    270262         ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DOM/domvvl.F90

    r12489 r13135  
    903903               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    904904 
    905                DO ji = 1, jpi 
    906                   DO jj = 1, jpj 
    907                      IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
    908                        CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
    909                      ENDIF 
    910                   END DO  
    911                END DO  
     905               DO_2D_11_11 
     906                  IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
     907                     CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
     908                  ENDIF 
     909               END_2D 
    912910               ! 
    913911            ELSE 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DOM/istate.F90

    r12489 r13135  
    2424   USE dom_oce        ! ocean space and time domain  
    2525   USE daymod         ! calendar 
    26    USE divhor         ! horizontal divergence            (div_hor routine) 
    2726   USE dtatsd         ! data temperature and salinity   (dta_tsd routine) 
    2827   USE dtauvd         ! data: U & V current             (dta_uvd routine) 
    … …  
    121120         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    122121         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
    123          hdiv(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
    124          CALL div_hor( 0, Kbb, Kmm )         ! compute interior hdiv value   
    125 !!gm                                    hdiv(:,:,:) = 0._wp 
    126122 
    127123!!gm POTENTIAL BUG : 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/divhor.F90

    r12546 r13135  
    8484      END_3D 
    8585      ! 
    86 #if defined key_agrif 
    87       IF( .NOT. Agrif_Root() ) THEN 
    88          IF( nbondi == -1 .OR. nbondi == 2 )   hdiv(   2   ,  :   ,:) = 0._wp      ! west 
    89          IF( nbondi ==  1 .OR. nbondi == 2 )   hdiv( nlci-1,  :   ,:) = 0._wp      ! east 
    90          IF( nbondj == -1 .OR. nbondj == 2 )   hdiv(   :   ,  2   ,:) = 0._wp      ! south 
    91          IF( nbondj ==  1 .OR. nbondj == 2 )   hdiv(   :   ,nlcj-1,:) = 0._wp      ! north 
    92       ENDIF 
    93 #endif 
    94       ! 
    9586      IF( ln_rnf )   CALL sbc_rnf_div( hdiv, Kmm )                     !==  runoffs    ==!   (update hdiv field) 
    9687      ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/dynldf_lap_blp.F90

    r12546 r13135  
    7474         DO_2D_01_01 
    7575            !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    76 !!gm open question here : e3f  at before or now ?    probably now... 
    77 !!gm note that ahmf has already been multiplied by fmask 
    78             zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       & 
     76            zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask 
    7977               &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  & 
    8078               &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  ) 
    8179            !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
    82 !!gm note that ahmt has already been multiplied by tmask 
    83             zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)                                         & 
     80            zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)               &   ! ahmt already * by tmask 
    8481               &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  & 
    8582               &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  ) 
    … …  
    8784         ! 
    8885         DO_2D_00_00 
    89             pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * (                                                 & 
     86            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
    9087               &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
    91                &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     ) 
     88               &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                      ) 
    9289               ! 
    93             pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * (                                                 & 
     90            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * (    &    ! * by vmask is mandatory for dyn_ldf_blp use 
    9491               &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm)   & 
    95                &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     ) 
     92               &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                      ) 
    9693         END_2D 
    9794         !                                             ! =============== 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/dynvor.F90

    r12546 r13135  
    810810         DO_3D_10_10( 1, jpk ) 
    811811            IF(    tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)              & 
    812                & + tmask(ji,jj  ,jk) + tmask(ji+1,jj+1,jk) == 3._wp )   fmask(ji,jj,jk) = 1._wp 
     812               & + tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk) == 3._wp )   fmask(ji,jj,jk) = 1._wp 
    813813         END_3D 
    814814         ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/DYN/sshwzv.F90

    r12546 r13135  
    202202#if defined key_agrif  
    203203      IF( .NOT. AGRIF_Root() ) THEN  
    204          IF ((nbondi ==  1).OR.(nbondi == 2)) pww(nlci-1 , :     ,:) = 0.e0      ! east  
    205          IF ((nbondi == -1).OR.(nbondi == 2)) pww(2      , :     ,:) = 0.e0      ! west  
    206          IF ((nbondj ==  1).OR.(nbondj == 2)) pww(:      ,nlcj-1 ,:) = 0.e0      ! north  
    207          IF ((nbondj == -1).OR.(nbondj == 2)) pww(:      ,2      ,:) = 0.e0      ! south  
     204         ! Mask vertical velocity at first/last columns/row  
     205         ! inside computational domain (cosmetic)  
     206         ! --- West --- ! 
     207         DO ji = mi0(2), mi1(2) 
     208            DO jj = 1, jpj 
     209               pww(ji,jj,:) = 0._wp  
     210            ENDDO 
     211         ENDDO 
     212         ! 
     213         ! --- East --- ! 
     214         DO ji = mi0(jpiglo-1), mi1(jpiglo-1) 
     215            DO jj = 1, jpj 
     216               pww(ji,jj,:) = 0._wp 
     217            ENDDO 
     218         ENDDO 
     219         ! 
     220         ! --- South --- ! 
     221         DO jj = mj0(2), mj1(2) 
     222            DO ji = 1, jpi 
     223               pww(ji,jj,:) = 0._wp 
     224            ENDDO 
     225         ENDDO 
     226         ! 
     227         ! --- North --- ! 
     228         DO jj = mj0(jpjglo-1), mj1(jpjglo-1) 
     229            DO ji = 1, jpi 
     230               pww(ji,jj,:) = 0._wp 
     231            ENDDO 
     232         ENDDO 
    208233      ENDIF  
    209234#endif  

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/FLO/floblk.F90

    r12603 r13135  
    175175            zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl)) 
    176176            IF( zufl(jfl)*zuoutfl <= 0. ) THEN 
     177<<<<<<< .working 
    177178               ztxfl(jfl) = HUGE(0.0_wp) 
     179||||||| .merge-left.r12512 
     180               ztxfl(jfl) = 1.E99 
     181======= 
     182               ztxfl(jfl) = HUGE(1._wp) 
     183>>>>>>> .merge-right.r13134 
    178184            ELSE 
    179185               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 
    … …  
    191197            zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl)) 
    192198            IF( zvfl(jfl)*zvoutfl <= 0. ) THEN 
    193                ztyfl(jfl) = HUGE(0.0_wp) 
     199               ztyfl(jfl) = HUGE(1._wp) 
    194200            ELSE 
    195201               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 
    … …  
    208214               zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl)) 
    209215               IF( zwfl(jfl)*zwoutfl <= 0. ) THEN 
    210                   ztzfl(jfl) = HUGE(0.0_wp) 
     216                  ztzfl(jfl) = HUGE(1._wp) 
    211217               ELSE 
    212218                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ICB/icbrst.F90

    r12472 r13135  
    188188      ! 
    189189      INTEGER ::   jn   ! dummy loop index 
     190      INTEGER ::   idg  ! number of digits 
    190191      INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim 
    191192      CHARACTER(len=256)     :: cl_path 
    192193      CHARACTER(len=256)     :: cl_filename 
    193       CHARACTER(len=256)     :: cl_kt 
     194      CHARACTER(len=8  )     :: cl_kt 
     195      CHARACTER(LEN=12 )     :: clfmt            ! writing format 
    194196      TYPE(iceberg), POINTER :: this 
    195197      TYPE(point)  , POINTER :: pt 
    … …  
    211213         ! file name 
    212214         WRITE(cl_kt, '(i8.8)') kt 
    213          cl_filename = TRIM(cexper)//"_"//TRIM(ADJUSTL(cl_kt))//"_"//TRIM(cn_icbrst_out) 
     215         cl_filename = TRIM(cexper)//"_"//cl_kt//"_"//TRIM(cn_icbrst_out) 
    214216         IF( lk_mpp ) THEN 
    215             WRITE(cl_filename,'(A,"_",I4.4,".nc")') TRIM(cl_filename), narea-1 
     217            idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     218            WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     219            WRITE(cl_filename,  clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 
    216220         ELSE 
    217             WRITE(cl_filename,'(A,".nc")') TRIM(cl_filename) 
     221            WRITE(cl_filename,'(a,a)') TRIM(cl_filename),               '.nc' 
    218222         ENDIF 
    219223 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ICB/icbtrj.F90

    r12489 r13135  
    6262      ! 
    6363      INTEGER                ::   iret, iyear, imonth, iday 
     64      INTEGER                ::   idg  ! number of digits 
    6465      REAL(wp)               ::   zfjulday, zsec 
    6566      CHARACTER(len=80)      ::   cl_filename 
    66       CHARACTER(LEN=20)      ::   cldate_ini, cldate_end 
     67      CHARACTER(LEN=12)      ::   clfmt            ! writing format 
     68      CHARACTER(LEN=8 )      ::   cldate_ini, cldate_end 
    6769      TYPE(iceberg), POINTER ::   this 
    6870      TYPE(point)  , POINTER ::   pt 
    … …  
    8082 
    8183      ! define trajectory output name 
    82       IF ( lk_mpp ) THEN   ;   WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A,"_",I4.4,".nc")')   & 
    83          &                        TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end)), narea-1 
    84       ELSE                 ;   WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A         ,".nc")')   & 
    85          &                        TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end)) 
     84      cl_filename = 'trajectory_icebergs_'//cldate_ini//'-'//cldate_end 
     85      IF ( lk_mpp ) THEN 
     86         idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     87         WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     88         WRITE(cl_filename,  clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 
     89      ELSE 
     90         WRITE(cl_filename,'(a,a)') TRIM(cl_filename),               '.nc' 
    8691      ENDIF 
    8792      IF( lwp .AND. nn_verbose_level >= 0 )   WRITE(numout,'(2a)') 'icebergs, icb_trj_init: creating ',TRIM(cl_filename) 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/IOM/in_out_manager.F90

    r12377 r13135  
    100100   !!---------------------------------------------------------------------- 
    101101   TYPE :: sn_ctl                !: structure for control over output selection 
    102       LOGICAL :: l_glochk  = .FALSE.  !: range sanity checks are local (F) or global (T) 
    103                                       !  Use global setting for debugging only; 
    104                                       !  local breaches will still be reported 
    105                                       !  and stop the code in most cases. 
    106       LOGICAL :: l_allon   = .FALSE.  !: overall control; activate all following output options 
    107       LOGICAL :: l_config  = .FALSE.  !: activate/deactivate finer control 
    108                                       !  Note if l_config is True then sn_cfctl%l_allon is ignored. 
    109                                       !  Otherwise setting sn_cfctl%l_allon T/F is equivalent to  
    110                                       !  setting all the following logicals in this structure T/F 
    111                                       !  and disabling subsetting of processors 
    112102      LOGICAL :: l_runstat = .FALSE.  !: Produce/do not produce run.stat file (T/F) 
    113103      LOGICAL :: l_trcstat = .FALSE.  !: Produce/do not produce tracer.stat file (T/F) 
    … …  
    169159   INTEGER       ::   no_print = 0          !: optional argument of fld_fill (if present, suppress some control print) 
    170160   INTEGER       ::   nstop = 0             !: error flag (=number of reason for a premature stop run) 
     161!$AGRIF_DO_NOT_TREAT 
     162   INTEGER       ::   ngrdstop = -1         !: grid number having nstop > 1 
     163!$AGRIF_END_DO_NOT_TREAT 
    171164   INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run) 
    172165   CHARACTER(lc) ::   ctmp1, ctmp2, ctmp3   !: temporary characters 1 to 3 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/IOM/iom.F90

    r12603 r13135  
    118118      CHARACTER(len=lc) :: clname 
    119119      INTEGER             :: irefyear, irefmonth, irefday 
    120       INTEGER           :: ji, jkmin 
     120      INTEGER           :: ji 
    121121      LOGICAL :: llrst_context              ! is context related to restart 
    122122      ! 
    … …  
    227227           
    228228          ! Add vertical grid bounds 
    229           jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D) 
    230           zt_bnds(2,:        ) = gdept_1d(:) 
    231           zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 
    232           zt_bnds(1,1        ) = gdept_1d(1) - e3w_1d(1) 
    233           zw_bnds(1,:        ) = gdepw_1d(:) 
    234           zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk) 
    235           zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk) 
     229          zt_bnds(2,:      ) = gdept_1d(:) 
     230          zt_bnds(1,2:jpk  ) = gdept_1d(1:jpkm1) 
     231          zt_bnds(1,1      ) = gdept_1d(1) - e3w_1d(1) 
     232          zw_bnds(1,:      ) = gdepw_1d(:) 
     233          zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 
     234          zw_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk) 
    236235          CALL iom_set_axis_attr(  "deptht", bounds=zw_bnds ) 
    237236          CALL iom_set_axis_attr(  "depthu", bounds=zw_bnds ) 
    … …  
    672671 
    673672 
    674    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev ) 
     673   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev, cdcomp ) 
    675674      !!--------------------------------------------------------------------- 
    676675      !!                   ***  SUBROUTINE  iom_open  *** 
    … …  
    685684      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 
    686685      INTEGER         , INTENT(in   ), OPTIONAL ::   kdlev    ! number of vertical levels 
     686      CHARACTER(len=3), INTENT(in   ), OPTIONAL ::   cdcomp   ! name of component calling iom_nf90_open 
    687687      ! 
    688688      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
    … …  
    830830      ENDIF 
    831831      IF( istop == nstop ) THEN   ! no error within this routine 
    832          CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev ) 
     832         CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev, cdcomp = cdcomp ) 
    833833      ENDIF 
    834834      ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/IOM/iom_def.F90

    r12377 r13135  
    3333   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 1200 !: maximum number of variables in one file 
    3434   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable 
    35    INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name 
     35   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  9   !: maximum number of digits for the cpu number in the file name 
    3636 
    3737 
    … …  
    5050   TYPE, PUBLIC ::   file_descriptor 
    5151      CHARACTER(LEN=240)                        ::   name     !: name of the file 
     52      CHARACTER(LEN=3  )                        ::   comp     !: name of component opening the file ('OCE', 'ICE'...) 
    5253      INTEGER                                   ::   nfid     !: identifier of the file (0 if closed) 
    5354                                                              !: jpioipsl option has been removed) 
    … …  
    6465      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables 
    6566      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables 
    66       INTEGER                                   ::   nlev     ! number of vertical levels 
    6767   END TYPE file_descriptor 
    6868   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/IOM/iom_nf90.F90

    r12603 r13135  
    1919   !!---------------------------------------------------------------------- 
    2020   USE dom_oce         ! ocean space and time domain 
    21    USE sbc_oce, ONLY: jpka, ght_abl ! abl vertical level number and height 
     21   USE sbc_oce, ONLY: ght_abl ! abl vertical level number and height 
    2222   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    2323   USE iom_def         ! iom variables definitions 
    … …  
    4747CONTAINS 
    4848 
    49    SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev ) 
     49   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev, cdcomp ) 
    5050      !!--------------------------------------------------------------------- 
    5151      !!                   ***  SUBROUTINE  iom_open  *** 
    … …  
    5959      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
    6060      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension 
     61      CHARACTER(len=3)       , INTENT(in   ), OPTIONAL ::   cdcomp      ! name of component calling iom_nf90_open 
    6162 
    6263      CHARACTER(LEN=256) ::   clinfo           ! info character 
    6364      CHARACTER(LEN=256) ::   cltmp            ! temporary character 
     65      CHARACTER(LEN=12 ) ::   clfmt            ! writing format 
     66      CHARACTER(LEN=3  ) ::   clcomp           ! name of component calling iom_nf90_open 
     67      INTEGER            ::   idg              ! number of digits 
    6468      INTEGER            ::   iln              ! lengths of character 
    6569      INTEGER            ::   istop            ! temporary storage of nstop 
    … …  
    7175      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5 
    7276      LOGICAL            ::   llclobber        ! local definition of ln_clobber 
    73       INTEGER            ::   ilevels          ! vertical levels 
    7477      !--------------------------------------------------------------------- 
    7578      ! 
    … …  
    7881      ! 
    7982      !                 !number of vertical levels 
    80       IF( PRESENT(kdlev) )   THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice and abl) 
    81       ELSE                          ;   ilevels = jpk      ! by default jpk 
     83      IF( PRESENT(cdcomp) )   THEN 
     84         IF( .NOT. PRESENT(kdlev) ) CALL ctl_stop( 'iom_nf90_open: cdcomp and kdlev must both be present' ) 
     85         clcomp = cdcomp    ! use input value 
     86      ELSE 
     87         clcomp = 'OCE'     ! by default  
    8288      ENDIF 
    8389      ! 
    … …  
    106112         IF( ldwrt ) THEN              !* the file should be open in write mode so we create it... 
    107113            IF( jpnij > 1 ) THEN 
    108                WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc' 
     114               idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     115               WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     116               WRITE(cltmp,clfmt) cdname(1:iln-1), '_', narea-1, '.nc' 
    109117               cdname = TRIM(cltmp) 
    110118            ENDIF 
    … …  
    126134            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL,                   idmy ), clinfo) 
    127135            ! define dimensions 
    128             CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
    129             CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo) 
    130             IF( PRESENT(kdlev) ) THEN 
    131               IF( kdlev == jpka ) THEN 
    132                  CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',          kdlev, idmy ), clinfo) 
    133                  CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    134               ELSE 
    135                  CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',            jpk, idmy ), clinfo) 
    136                  CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    137                  CALL iom_nf90_check(NF90_DEF_DIM( if90id,  'numcat',          kdlev, idmy ), clinfo) 
    138               ENDIF 
    139             ELSE 
    140                CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',            jpk, idmy ), clinfo) 
    141                CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    142             ENDIF 
     136                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
     137                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo) 
     138            SELECT CASE (clcomp) 
     139            CASE ('OCE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo) 
     140            CASE ('ICE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numcat',          kdlev, idmy ), clinfo) 
     141            CASE ('ABL')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',          kdlev, idmy ), clinfo) 
     142            CASE ('SED')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numsed',          kdlev, idmy ), clinfo) 
     143            CASE DEFAULT   ;   CALL ctl_stop( 'iom_nf90_open unknown component type' ) 
     144            END SELECT 
     145                               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    143146            ! global attributes 
    144147            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo) 
    … …  
    166169         ENDDO 
    167170         iom_file(kiomid)%name   = TRIM(cdname) 
     171         iom_file(kiomid)%comp   = clcomp 
    168172         iom_file(kiomid)%nfid   = if90id 
    169173         iom_file(kiomid)%nvars  = 0 
    170174         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode  
    171          iom_file(kiomid)%nlev   = ilevels 
    172175         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 
    173176         IF( iom_file(kiomid)%iduld .GE. 0 ) THEN 
    … …  
    546549      INTEGER, DIMENSION(4) :: idimid               ! dimensions id 
    547550      CHARACTER(LEN=256)    :: clinfo               ! info character 
    548       CHARACTER(LEN= 12), DIMENSION(5) :: cltmp     ! temporary character 
    549551      INTEGER               :: if90id               ! nf90 file identifier 
    550       INTEGER               :: idmy                 ! dummy variable 
    551552      INTEGER               :: itype                ! variable type 
    552553      INTEGER, DIMENSION(4) :: ichunksz             ! NetCDF4 chunk sizes. Will be computed using 
    … …  
    557558      !                                             ! when appropriate (currently chunking is applied to 4d fields only) 
    558559      INTEGER               :: idlv                 ! local variable 
    559       INTEGER               :: idim3                ! id of the third dimension 
    560560      !--------------------------------------------------------------------- 
    561561      ! 
    … …  
    571571         ENDIF 
    572572         ! define the dimension variables if it is not already done 
    573          ! Warning: we must use the same character length in an array constructor (at least for gcc compiler) 
    574          cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter', 'numcat      ' /)    
    575          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo) 
    576          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo) 
    577          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3    /), iom_file(kiomid)%nvid(3) ), clinfo) 
    578          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4    /), iom_file(kiomid)%nvid(4) ), clinfo) 
     573         DO jd = 1, 2 
     574            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(jd,jd)),clinfo) 
     575            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ 1, 2 /),   & 
     576               &                              iom_file(kiomid)%nvid(jd) ), clinfo) 
     577         END DO 
     578         iom_file(kiomid)%dimsz(2,1) = iom_file(kiomid)%dimsz(2,2)   ! second dim of first  variable 
     579         iom_file(kiomid)%dimsz(1,2) = iom_file(kiomid)%dimsz(1,1)   ! first  dim of second variable 
     580         DO jd = 3, 4 
     581            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(1,jd)), clinfo) 
     582            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ jd   /),   & 
     583               &                              iom_file(kiomid)%nvid(jd) ), clinfo) 
     584         END DO 
    579585         ! update informations structure related the dimension variable we just added... 
    580586         iom_file(kiomid)%nvars       = 4 
    581587         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /) 
    582          iom_file(kiomid)%cn_var(1:4) = cltmp(1:4) 
    583588         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /) 
    584          IF( NF90_INQ_DIMID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN   ! add a 5th variable corresponding to the 5th dimension 
    585             CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(5)), NF90_FLOAT , (/ 5 /), iom_file(kiomid)%nvid(5) ), clinfo) 
    586             iom_file(kiomid)%nvars     = 5 
    587             iom_file(kiomid)%luld(5)   = .FALSE. 
    588             iom_file(kiomid)%cn_var(5) = cltmp(5) 
    589             iom_file(kiomid)%ndims(5)  = 1 
    590          ENDIF 
    591          ! trick: defined to 0 to say that dimension variables are defined but not yet written 
    592          iom_file(kiomid)%dimsz(1, 1)  = 0    
    593589         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done' 
    594590      ENDIF 
    … …  
    611607         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0 
    612608         ELSEIF( PRESENT(pv_r1d) ) THEN 
    613             IF(( SIZE(pv_r1d,1) == jpk ).OR.( SIZE(pv_r1d,1) == jpka )) THEN   ;   idim3 = 3 
    614             ELSE                                                               ;   idim3 = 5 
    615             ENDIF 
    616                                               idims = 2   ;   idimid(1:idims) = (/idim3,4/) 
    617          ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/) 
     609                                              idims = 2   ;   idimid(1:idims) = (/3,4/) 
     610         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2,4/) 
    618611         ELSEIF( PRESENT(pv_r3d) ) THEN 
    619             IF(( SIZE(pv_r3d,3) == jpk ).OR.( SIZE(pv_r3d,3) == jpka )) THEN   ;   idim3 = 3 
    620             ELSE                                                               ;   idim3 = 5 
    621             ENDIF 
    622                                               idims = 4   ;   idimid(1:idims) = (/1,2,idim3,4/) 
     612                                              idims = 4   ;   idimid(1:idims) = (/1,2,3,4/) 
    623613         ENDIF 
    624614         IF( PRESENT(ktype) ) THEN   ! variable external type 
    … …  
    695685            ! ============= 
    696686            ! trick: is defined to 0 => dimension variable are defined but not yet written 
    697             IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 
    698                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lon'     , idmy )         , clinfo ) 
    699                CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo ) 
    700                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lat'     , idmy )         , clinfo ) 
    701                CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 
    702                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo ) 
    703                IF (iom_file(kiomid)%nlev == jpka) THEN   ;   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy,  ght_abl), clinfo ) 
    704                ELSE                                      ;   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d), clinfo ) 
    705                ENDIF 
    706                IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN 
    707                   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo ) 
    708                ENDIF 
    709                ! +++ WRONG VALUE: to be improved but not really useful... 
    710                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo ) 
    711                CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo )    
    712                ! update the values of the variables dimensions size 
    713                CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo ) 
    714                CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo ) 
    715                iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 
    716                CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo ) 
    717                iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension 
     687            IF( iom_file(kiomid)%dimsz(1, 4) == 0 ) THEN   ! time_counter = 0 
     688               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 1,                            glamt(ix1:ix2, iy1:iy2) ), clinfo ) 
     689               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 2,                            gphit(ix1:ix2, iy1:iy2) ), clinfo ) 
     690               SELECT CASE (iom_file(kiomid)%comp) 
     691               CASE ('OCE')   
     692                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                           gdept_1d ), clinfo ) 
     693               CASE ('ABL') 
     694                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                            ght_abl ), clinfo ) 
     695               CASE DEFAULT 
     696                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, (/ (idlv, idlv = 1,iom_file(kiomid)%dimsz(1,3)) /) ), clinfo ) 
     697               END SELECT 
     698               ! "wrong" value: to be improved but not really useful... 
     699               CALL iom_nf90_check(   NF90_PUT_VAR( if90id, 4,                                                  kt ), clinfo )    
     700               ! update the size of the variable corresponding to the unlimited dimension 
     701               iom_file(kiomid)%dimsz(1, 4) = 1   ! so we don't enter this IF case any more... 
    718702               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' 
    719703            ENDIF 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ISF/isfdiags.F90

    r12340 r13135  
    8888      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac  ! thickness of the tbl and fraction of last cell affected by the tbl 
    8989      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pvar2d        ! 2d var to map in 3d 
    90       CHARACTER(LEN=256), INTENT(in) :: cdvar 
     90      CHARACTER(LEN=*), INTENT(in) :: cdvar 
    9191      !!--------------------------------------------------------------------- 
    9292      INTEGER  :: ji, jj, jk                       ! loop indices 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/lib_mpp.F90

    r12603 r13135  
    13331333      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::        cd2, cd3, cd4, cd5 
    13341334      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::   cd6, cd7, cd8, cd9, cd10 
     1335      ! 
     1336      CHARACTER(LEN=8) ::   clfmt            ! writing format 
     1337      INTEGER          ::   inum 
    13351338      !!---------------------------------------------------------------------- 
    13361339      ! 
    13371340      nstop = nstop + 1 
    13381341      ! 
    1339       ! force to open ocean.output file if not already opened 
    1340       IF( numout == 6 ) CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     1342      IF( cd1 == 'STOP' .AND. narea /= 1 ) THEN    ! Immediate stop: add an arror message in 'ocean.output' file 
     1343         CALL ctl_opn( inum, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     1344         WRITE(inum,*) 
     1345         WRITE(inum,*) ' ==>>>   Look for "E R R O R" messages in all existing *ocean.output* files' 
     1346         CLOSE(inum) 
     1347      ENDIF 
     1348      IF( numout == 6 ) THEN                       ! force to open ocean.output file if not already opened 
     1349         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 
     1350      ENDIF 
    13411351      ! 
    13421352                            WRITE(numout,*) 
    … …  
    13661376         WRITE(numout,*)  'huge E-R-R-O-R : immediate stop' 
    13671377         WRITE(numout,*)   
     1378         CALL FLUSH(numout) 
     1379         CALL SLEEP(60)   ! make sure that all output and abort files are written by all cores. 60s should be enough... 
    13681380         CALL mppstop( ld_abort = .true. ) 
    13691381      ENDIF 
    … …  
    14281440      ! 
    14291441      CHARACTER(len=80) ::   clfile 
     1442      CHARACTER(LEN=10) ::   clfmt            ! writing format 
    14301443      INTEGER           ::   iost 
     1444      INTEGER           ::   idg              ! number of digits 
    14311445      !!---------------------------------------------------------------------- 
    14321446      ! 
    … …  
    14351449      clfile = TRIM(cdfile) 
    14361450      IF( PRESENT( karea ) ) THEN 
    1437          IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1 
     1451         IF( karea > 1 ) THEN 
     1452            ! Warning: jpnij is maybe not already defined when calling ctl_opn -> use mppsize instead of jpnij 
     1453            idg = MAX( INT(LOG10(REAL(MAX(1,mppsize-1),wp))) + 1, 4 )      ! how many digits to we need to write? min=4, max=9 
     1454            WRITE(clfmt, "('(a,a,i', i1, '.', i1, ')')") idg, idg          ! '(a,a,ix.x)' 
     1455            WRITE(clfile, clfmt) TRIM(clfile), '_', karea-1 
     1456         ENDIF 
    14381457      ENDIF 
    14391458#if defined key_agrif 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/mpp_loc_generic.h90

    r12603 r13135  
    4040      REAL(PRECISION)        , INTENT(  out) ::   pmin    ! Global minimum of ptab 
    4141      INDEX_TYPE(:)                                ! index of minimum in global frame 
    42 # if defined key_mpp_mpi 
    4342      ! 
    4443      INTEGER  ::   ierror, ii, idim 
    … …  
    6463         ! 
    6564         kindex(1) = mig( ilocs(1) ) 
    66 #  if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */ 
     65#if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */ 
    6766         kindex(2) = mjg( ilocs(2) ) 
    68 #  endif 
    69 #  if defined DIM_3d                      /* avoid warning when kindex has 2 elements */ 
     67#endif 
     68#if defined DIM_3d                      /* avoid warning when kindex has 2 elements */ 
    7069         kindex(3) = ilocs(3) 
    71 #  endif 
     70#endif 
    7271         !  
    7372         DEALLOCATE (ilocs) 
    7473         ! 
    7574         index0 = kindex(1)-1   ! 1d index starting at 0 
    76 #  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
     75#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
    7776         index0 = index0 + jpiglo * (kindex(2)-1) 
    78 #  endif 
    79 #  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
     77#endif 
     78#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
    8079         index0 = index0 + jpiglo * jpjglo * (kindex(3)-1) 
    81 #  endif 
     80#endif 
    8281      END IF 
    8382      zain(1,:) = zmin 
    … …  
    8584      ! 
    8685      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.) 
     86#if defined key_mpp_mpi 
    8787      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror) 
     88#else 
     89      zaout(:,:) = zain(:,:) 
     90#endif 
    8891      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    8992      ! 
    9093      pmin      = zaout(1,1) 
    9194      index0    = NINT( zaout(2,1) ) 
    92 #  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
     95#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
    9396      kindex(3) = index0 / (jpiglo*jpjglo) 
    9497      index0    = index0 - kindex(3) * (jpiglo*jpjglo) 
    95 #  endif 
    96 #  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
     98#endif 
     99#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
    97100      kindex(2) = index0 / jpiglo 
    98101      index0 = index0 - kindex(2) * jpiglo 
    99 #  endif 
     102#endif 
    100103      kindex(1) = index0 
    101104      kindex(:) = kindex(:) + 1   ! start indices at 1 
    102 #else 
    103       kindex = 0 ; pmin = 0. 
    104       WRITE(*,*) 'ROUTINE_LOC: You should not have seen this print! error?' 
    105 #endif 
    106105 
    107106   END SUBROUTINE ROUTINE_LOC 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/OBS/obs_grid.F90

    r10068 r13135  
    684684         & fhistx1, fhistx2, fhisty1, fhisty2 
    685685      REAL(wp) :: histtol 
    686        
     686      CHARACTER(LEN=26) :: clfmt            ! writing format 
     687      INTEGER           :: idg              ! number of digits 
     688  
    687689      IF (ln_grid_search_lookup) THEN 
    688690          
    … …  
    709711 
    710712         IF ( ln_grid_global ) THEN 
    711             WRITE(cfname, FMT="(A,'_',A)") & 
    712                &          TRIM(cn_gridsearchfile), 'global.nc' 
     713            WRITE(cfname, FMT="(A,'_',A)") TRIM(cn_gridsearchfile), 'global.nc' 
    713714         ELSE 
    714             WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") & 
    715                &          TRIM(cn_gridsearchfile), nproc, jpni, jpnj 
     715            idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )        ! how many digits to we need to write? min=4, max=9 
     716            ! define the following format: "(a,a,ix.x,a,ix.x,a,ix.x,a)" 
     717            WRITE(clfmt, "('(a,a,i', i1, '.', i1',a,i', i1, '.', i1',a,i', i1, '.', i1',a)')") idg, idg, idg, idg, idg, idg 
     718            WRITE(cfname,      clfmt     ) TRIM(cn_gridsearchfile),'_', nproc,'of', jpni,'by', jpnj,'.nc' 
    716719         ENDIF 
    717720 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/OBS/obs_write.F90

    r12377 r13135  
    8686      CHARACTER(LEN=40) :: clfname 
    8787      CHARACTER(LEN=10) :: clfiletype 
     88      CHARACTER(LEN=12) :: clfmt            ! writing format 
     89      INTEGER :: idg                        ! number of digits 
    8890      INTEGER :: ilevel 
    8991      INTEGER :: jvar 
    … …  
    181183      fbdata%caddname(1)   = 'Hx' 
    182184 
    183       WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
     185      idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )            ! how many digits to we need to write? min=4, max=9 
     186      WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg   ! '(a,a,ix.x,a)' 
     187      WRITE(clfname,clfmt) TRIM(clfiletype), '_fdbk_', nproc, '.nc' 
    184188 
    185189      IF(lwp) THEN 
    … …  
    326330      CHARACTER(LEN=10) :: clfiletype 
    327331      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf' 
     332      CHARACTER(LEN=12) :: clfmt           ! writing format 
     333      INTEGER :: idg                       ! number of digits 
    328334      INTEGER :: jo 
    329335      INTEGER :: ja 
    … …  
    453459      fbdata%caddname(1)   = 'Hx' 
    454460 
    455       WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
     461      idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )            ! how many digits to we need to write? min=4, max=9 
     462      WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg   ! '(a,a,ix.x,a)' 
     463      WRITE(clfname,clfmt) TRIM(clfiletype), '_fdbk_', nproc, '.nc' 
    456464 
    457465      IF(lwp) THEN 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk.F90

    r12546 r13135  
    627627 
    628628      END SELECT 
    629  
     629       
     630      IF( iom_use('Cd_oce') )   CALL iom_put("Cd_oce",   zcd_oce * tmask(:,:,1)) 
     631      IF( iom_use('Ce_oce') )   CALL iom_put("Ce_oce",   zce_oce * tmask(:,:,1)) 
     632      IF( iom_use('Ch_oce') )   CALL iom_put("Ch_oce",   zch_oce * tmask(:,:,1)) 
     633      !! LB: mainly here for debugging purpose: 
     634      IF( iom_use('theta_zt') ) CALL iom_put("theta_zt", (ztpot-rt0) * tmask(:,:,1)) ! potential temperature at z=zt 
     635      IF( iom_use('q_zt') )     CALL iom_put("q_zt",     zqair       * tmask(:,:,1)) ! specific humidity       " 
     636      IF( iom_use('theta_zu') ) CALL iom_put("theta_zu", (t_zu -rt0) * tmask(:,:,1)) ! potential temperature at z=zu 
     637      IF( iom_use('q_zu') )     CALL iom_put("q_zu",     q_zu        * tmask(:,:,1)) ! specific humidity       " 
     638      IF( iom_use('ssq') )      CALL iom_put("ssq",      pssq        * tmask(:,:,1)) ! saturation specific humidity at z=0 
     639      IF( iom_use('wspd_blk') ) CALL iom_put("wspd_blk", zU_zu       * tmask(:,:,1)) ! bulk wind speed at z=zu 
     640       
    630641      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
    631642         !! ptsk and pssq have been updated!!! 
    … …  
    639650      END IF 
    640651 
    641       !!      CALL iom_put( "Cd_oce", zcd_oce)  ! output value of pure ocean-atm. transfer coef. 
    642       !!      CALL iom_put( "Ch_oce", zch_oce)  ! output value of pure ocean-atm. transfer coef. 
    643  
    644       IF( ABS(rn_zu - rn_zqt) < 0.1_wp ) THEN 
    645          !! If zu == zt, then ensuring once for all that: 
    646          t_zu(:,:) = ztpot(:,:) 
    647          q_zu(:,:) = zqair(:,:) 
    648       ENDIF 
    649  
    650  
    651652      !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbcblk_phy.F90 
    652653      ! ------------------------------------------------------------- 
    653654 
    654655      IF( ln_abl ) THEN         !==  ABL formulation  ==!   multiplication by rho_air and turbulent fluxes computation done in ablstp 
    655          !! FL do we need this multiplication by tmask ... ??? 
    656656         DO_2D_11_11 
    657             zztmp = zU_zu(ji,jj) !* tmask(ji,jj,1) 
     657            zztmp = zU_zu(ji,jj) 
    658658            wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod 
    659659            pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj) 
    660660            psen(ji,jj)   = zztmp * zch_oce(ji,jj) 
    661661            pevp(ji,jj)   = zztmp * zce_oce(ji,jj) 
     662            rhoa(ji,jj)   = rho_air( ptair(ji,jj), phumi(ji,jj), pslp(ji,jj) ) 
    662663         END_2D 
    663664      ELSE                      !==  BLK formulation  ==!   turbulent fluxes computation 
    664665         CALL BULK_FORMULA( rn_zu, ptsk(:,:), pssq(:,:), t_zu(:,:), q_zu(:,:), & 
    665             &               zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:),         & 
    666             &               wndm(:,:), zU_zu(:,:), pslp(:,:),                 & 
    667             &               taum(:,:), psen(:,:), zqla(:,:),                  & 
    668             &               pEvap=pevp(:,:), prhoa=rhoa(:,:) ) 
     666            &               zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:),          & 
     667            &               wndm(:,:), zU_zu(:,:), pslp(:,:),                  & 
     668            &               taum(:,:), psen(:,:), zqla(:,:),                   & 
     669            &               pEvap=pevp(:,:), prhoa=rhoa(:,:), pfact_evap=rn_efac ) 
    669670 
    670671         zqla(:,:) = zqla(:,:) * tmask(:,:,1) 
    … …  
    683684         ! ... utau, vtau at U- and V_points, resp. 
    684685         !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
    685          !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves 
    686          DO_2D_10_10 
     686         !     Note that coastal wind stress is not used in the code... so this extra care has no effect 
     687         DO_2D_00_00 
    687688            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) & 
    688689               &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 
    … …  
    888889         Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical 
    889890      ENDIF 
    890  
    891       !! IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice)   ! output value of pure ice-atm. transfer coef. 
    892       !! IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice)   ! output value of pure ice-atm. transfer coef. 
    893  
     891       
     892      IF( iom_use('Cd_ice') ) CALL iom_put("Cd_ice", Cd_ice) 
     893      IF( iom_use('Ce_ice') ) CALL iom_put("Ce_ice", Ce_ice) 
     894      IF( iom_use('Ch_ice') ) CALL iom_put("Ch_ice", Ch_ice) 
     895       
    894896      ! local scalars ( place there for vector optimisation purposes) 
    895       !IF (ln_abl) rhoa  (:,:)  = rho_air( ptair(:,:), phumi(:,:), pslp(:,:) ) !!GS: rhoa must be (re)computed here with ABL to avoid division by zero after (TBI) 
    896897      zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) 
    897898 
    898899      IF( ln_blk ) THEN 
    899          ! ------------------------------------------------------------ ! 
    900          !    Wind stress relative to the moving ice ( U10m - U_ice )   ! 
    901          ! ------------------------------------------------------------ ! 
    902          ! C-grid ice dynamics :   U & V-points (same as ocean) 
    903          DO_2D_00_00 
    904             putaui(ji,jj) = 0.5_wp * (  rhoa(ji+1,jj) * zcd_dui(ji+1,jj)             & 
    905                &                      + rhoa(ji  ,jj) * zcd_dui(ji  ,jj)  )          & 
    906                &         * ( 0.5_wp * ( pwndi(ji+1,jj) + pwndi(ji,jj) ) - rn_vfac * puice(ji,jj) ) 
    907             pvtaui(ji,jj) = 0.5_wp * (  rhoa(ji,jj+1) * zcd_dui(ji,jj+1)             & 
    908                &                      + rhoa(ji,jj  ) * zcd_dui(ji,jj  )  )          & 
    909                &         * ( 0.5_wp * ( pwndj(ji,jj+1) + pwndj(ji,jj) ) - rn_vfac * pvice(ji,jj) ) 
     900         ! ------------------------------------------------------------- ! 
     901         !    Wind stress relative to the moving ice ( U10m - U_ice )    ! 
     902         ! ------------------------------------------------------------- ! 
     903         zztmp1 = rn_vfac * 0.5_wp 
     904         DO_2D_01_01    ! at T point  
     905            putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndi(ji,jj) - zztmp1 * ( puice(ji-1,jj  ) + puice(ji,jj) ) ) 
     906            pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndj(ji,jj) - zztmp1 * ( pvice(ji  ,jj-1) + pvice(ji,jj) ) ) 
    910907         END_2D 
    911          CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1.0_wp, pvtaui, 'V', -1.0_wp ) 
     908         ! 
     909         DO_2D_00_00    ! U & V-points (same as ocean). 
     910            ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology  
     911            zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
     912            zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) ) 
     913            putaui(ji,jj) = zztmp1 * ( putaui(ji,jj) + putaui(ji+1,jj  ) ) 
     914            pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji  ,jj+1) ) 
     915         END_2D 
     916         CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1._wp, pvtaui, 'V', -1._wp ) 
    912917         ! 
    913918         IF(sn_cfctl%l_prtctl)  CALL prt_ctl( tab2d_1=putaui  , clinfo1=' blk_ice: putaui : '   & 
    … …  
    10461051      evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_rLsub    ! sublimation 
    10471052      devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_rLsub    ! d(sublimation)/dT 
    1048       zevap    (:,:)   = rn_efac * ( emp(:,:) + tprecip(:,:) )   ! evaporation over ocean 
     1053      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean  !LB: removed rn_efac here, correct??? 
    10491054 
    10501055      ! --- evaporation minus precipitation --- ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk_algo_coare3p0.F90

    r12377 r13135  
    194194      IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P0_INIT(l_use_cs, l_use_wl) 
    195195 
    196       l_zt_equal_zu = .FALSE. 
    197       IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     196      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    198197      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) ) 
    199198 
    … …  
    396395      ! 
    397396      DO_2D_11_11 
    398          ! 
    399          zw = pwnd(ji,jj)   ! wind speed 
    400          ! 
    401          ! Charnock's constant, increases with the wind : 
    402          zgt10 = 0.5 + SIGN(0.5_wp,(zw - 10))  ! If zw<10. --> 0, else --> 1 
    403          zgt18 = 0.5 + SIGN(0.5_wp,(zw - 18.)) ! If zw<18. --> 0, else --> 1 
    404          ! 
    405          alfa_charn_3p0(ji,jj) =  (1. - zgt10)*0.011    &    ! wind is lower than 10 m/s 
    406             &     + zgt10*((1. - zgt18)*(0.011 + (0.018 - 0.011) & 
    407             &      *(zw - 10.)/(18. - 10.)) + zgt18*( 0.018 ) )    ! Hare et al. (1999) 
    408          ! 
     397      ! 
     398      zw = pwnd(ji,jj)   ! wind speed 
     399      ! 
     400      ! Charnock's constant, increases with the wind : 
     401      zgt10 = 0.5 + SIGN(0.5_wp,(zw - 10))  ! If zw<10. --> 0, else --> 1 
     402      zgt18 = 0.5 + SIGN(0.5_wp,(zw - 18.)) ! If zw<18. --> 0, else --> 1 
     403      ! 
     404      alfa_charn_3p0(ji,jj) =  (1. - zgt10)*0.011    &    ! wind is lower than 10 m/s 
     405         &     + zgt10*((1. - zgt18)*(0.011 + (0.018 - 0.011) & 
     406         &      *(zw - 10.)/(18. - 10.)) + zgt18*( 0.018 ) )    ! Hare et al. (1999) 
     407      ! 
    409408      END_2D 
    410409      ! 
    … …  
    432431      ! 
    433432      DO_2D_11_11 
    434          ! 
    435          zta = pzeta(ji,jj) 
    436          ! 
    437          zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
    438          ! 
    439          zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
    440             & - 2.*ATAN(zphi_m) + 0.5*rpi 
    441          ! 
    442          zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
    443          ! 
    444          zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    445             &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    446          ! 
    447          zf = zta*zta 
    448          zf = zf/(1. + zf) 
    449          zc = MIN(50._wp, 0.35_wp*zta) 
    450          zstab = 0.5 + SIGN(0.5_wp, zta) 
    451          ! 
    452          psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
    453             &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
    454             &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     " 
    455          ! 
     433      ! 
     434      zta = pzeta(ji,jj) 
     435      ! 
     436      zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
     437      ! 
     438      zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
     439         & - 2.*ATAN(zphi_m) + 0.5*rpi 
     440      ! 
     441      zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
     442      ! 
     443      zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     444         &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     445      ! 
     446      zf = zta*zta 
     447      zf = zf/(1. + zf) 
     448      zc = MIN(50._wp, 0.35_wp*zta) 
     449      zstab = 0.5 + SIGN(0.5_wp, zta) 
     450      ! 
     451      psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
     452         &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
     453         &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     " 
     454      ! 
    456455      END_2D 
    457456      ! 
    … …  
    483482      ! 
    484483      DO_2D_11_11 
    485          ! 
    486          zta = pzeta(ji,jj) 
    487          ! 
    488          zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
    489          ! 
    490          zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
    491          ! 
    492          zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
    493          ! 
    494          zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    495             &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    496          ! 
    497          zf = zta*zta 
    498          zf = zf/(1. + zf) 
    499          zc = MIN(50._wp,0.35_wp*zta) 
    500          zstab = 0.5 + SIGN(0.5_wp, zta) 
    501          ! 
    502          psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
    503             &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
    504             &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
    505          ! 
     484      ! 
     485      zta = pzeta(ji,jj) 
     486      ! 
     487      zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
     488      ! 
     489      zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
     490      ! 
     491      zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
     492      ! 
     493      zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     494         &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     495      ! 
     496      zf = zta*zta 
     497      zf = zf/(1. + zf) 
     498      zc = MIN(50._wp,0.35_wp*zta) 
     499      zstab = 0.5 + SIGN(0.5_wp, zta) 
     500      ! 
     501      psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
     502         &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
     503         &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
     504      ! 
    506505      END_2D 
    507506      ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk_algo_coare3p6.F90

    r12377 r13135  
    194194      IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P6_INIT(l_use_cs, l_use_wl) 
    195195 
    196       l_zt_equal_zu = .FALSE. 
    197       IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     196      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    198197      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) ) 
    199198 
    … …  
    432431      ! 
    433432      DO_2D_11_11 
    434          ! 
    435          zta = pzeta(ji,jj) 
    436          ! 
    437          zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
    438          ! 
    439          zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
    440             & - 2.*ATAN(zphi_m) + 0.5*rpi 
    441          ! 
    442          zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
    443          ! 
    444          zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    445             &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    446          ! 
    447          zf = zta*zta 
    448          zf = zf/(1. + zf) 
    449          zc = MIN(50._wp, 0.35_wp*zta) 
    450          zstab = 0.5 + SIGN(0.5_wp, zta) 
    451          ! 
    452          psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
    453             &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
    454             &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     " 
    455          ! 
     433      ! 
     434      zta = pzeta(ji,jj) 
     435      ! 
     436      zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
     437      ! 
     438      zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
     439         & - 2.*ATAN(zphi_m) + 0.5*rpi 
     440      ! 
     441      zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
     442      ! 
     443      zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     444         &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     445      ! 
     446      zf = zta*zta 
     447      zf = zf/(1. + zf) 
     448      zc = MIN(50._wp, 0.35_wp*zta) 
     449      zstab = 0.5 + SIGN(0.5_wp, zta) 
     450      ! 
     451      psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
     452         &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
     453         &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     " 
     454      ! 
    456455      END_2D 
    457456      ! 
    … …  
    483482      ! 
    484483      DO_2D_11_11 
    485          ! 
    486          zta = pzeta(ji,jj) 
    487          ! 
    488          zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
    489          ! 
    490          zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
    491          ! 
    492          zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
    493          ! 
    494          zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    495             &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    496          ! 
    497          zf = zta*zta 
    498          zf = zf/(1. + zf) 
    499          zc = MIN(50._wp,0.35_wp*zta) 
    500          zstab = 0.5 + SIGN(0.5_wp, zta) 
    501          ! 
    502          psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
    503             &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
    504             &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
    505          ! 
     484      ! 
     485      zta = pzeta(ji,jj) 
     486      ! 
     487      zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
     488      ! 
     489      zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
     490      ! 
     491      zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
     492      ! 
     493      zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     494         &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     495      ! 
     496      zf = zta*zta 
     497      zf = zf/(1. + zf) 
     498      zc = MIN(50._wp,0.35_wp*zta) 
     499      zstab = 0.5 + SIGN(0.5_wp, zta) 
     500      ! 
     501      psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
     502         &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
     503         &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
     504      ! 
    506505      END_2D 
    507506      ! 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk_algo_ecmwf.F90

    r12377 r13135  
    9898      &                      Qsw, rad_lw, slp, pdT_cs,                                & ! optionals for cool-skin (and warm-layer) 
    9999      &                      pdT_wl, pHz_wl )                                           ! optionals for warm-layer only 
    100       !!---------------------------------------------------------------------- 
     100      !!---------------------------------------------------------------------------------- 
    101101      !!                      ***  ROUTINE  turb_ecmwf  *** 
    102102      !! 
    … …  
    184184      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    185185      ! 
    186       REAL(wp), DIMENSION(jpi,jpj) ::  u_star, t_star, q_star 
    187       REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu      
    188       REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air 
     186      REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star 
     187      REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu 
     188      REAL(wp), DIMENSION(jpi,jpj) :: znu_a         !: Nu_air, Viscosity of air 
    189189      REAL(wp), DIMENSION(jpi,jpj) :: Linv  !: 1/L (inverse of Monin Obukhov length... 
    190190      REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q 
    … …  
    196196      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90' 
    197197      !!---------------------------------------------------------------------------------- 
    198  
    199198      IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl) 
    200199 
    201       l_zt_equal_zu = .FALSE. 
    202       IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     200      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    203201 
    204202      !! Initializations for cool skin and warm layer: 
    … …  
    413411      !!---------------------------------------------------------------------------------- 
    414412      DO_2D_11_11 
    415          ! 
    416          zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): 
    417          ! 
    418          ! Unstable (Paulson 1970): 
    419          !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
    420          zx = SQRT(ABS(1._wp - 16._wp*zzeta)) 
    421          ztmp = 1._wp + SQRT(zx) 
    422          ztmp = ztmp*ztmp 
    423          psi_unst = LOG( 0.125_wp*ztmp*(1._wp + zx) )   & 
    424             &       -2._wp*ATAN( SQRT(zx) ) + 0.5_wp*rpi 
    425          ! 
    426          ! Unstable: 
    427          ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
    428          psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & 
    429             &       - zzeta - 2._wp/3._wp*5._wp/0.35_wp 
    430          ! 
    431          ! Combining: 
    432          stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
    433          ! 
    434          psi_m_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable 
    435             &                +      stab  * psi_stab      ! (zzeta > 0) Stable 
    436          ! 
     413      ! 
     414      zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): 
     415      ! 
     416      ! Unstable (Paulson 1970): 
     417      !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
     418      zx = SQRT(ABS(1._wp - 16._wp*zzeta)) 
     419      ztmp = 1._wp + SQRT(zx) 
     420      ztmp = ztmp*ztmp 
     421      psi_unst = LOG( 0.125_wp*ztmp*(1._wp + zx) )   & 
     422         &       -2._wp*ATAN( SQRT(zx) ) + 0.5_wp*rpi 
     423      ! 
     424      ! Unstable: 
     425      ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
     426      psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & 
     427         &       - zzeta - 2._wp/3._wp*5._wp/0.35_wp 
     428      ! 
     429      ! Combining: 
     430      stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
     431      ! 
     432      psi_m_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable 
     433         &                +      stab  * psi_stab      ! (zzeta > 0) Stable 
     434      ! 
    437435      END_2D 
    438436   END FUNCTION psi_m_ecmwf 
    … …  
    458456      ! 
    459457      DO_2D_11_11 
    460          ! 
    461          zzeta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!): 
    462          ! 
    463          zx  = ABS(1._wp - 16._wp*zzeta)**.25        ! this is actually (1/phi_m)**2  !!! 
    464          !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1 
    465          ! Unstable (Paulson 1970) : 
    466          psi_unst = 2._wp*LOG(0.5_wp*(1._wp + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
    467          ! 
    468          ! Stable: 
    469          psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
    470             &       - ABS(1._wp + 2._wp/3._wp*zzeta)**1.5_wp - 2._wp/3._wp*5._wp/0.35_wp + 1._wp 
    471          ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution... 
    472          ! 
    473          stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
    474          ! 
    475          ! 
    476          psi_h_ecmwf(ji,jj) = (1._wp - stab) * psi_unst &   ! (zzeta < 0) Unstable 
    477             &                +    stab    * psi_stab        ! (zzeta > 0) Stable 
    478          ! 
     458      ! 
     459      zzeta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!): 
     460      ! 
     461      zx  = ABS(1._wp - 16._wp*zzeta)**.25        ! this is actually (1/phi_m)**2  !!! 
     462      !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1 
     463      ! Unstable (Paulson 1970) : 
     464      psi_unst = 2._wp*LOG(0.5_wp*(1._wp + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
     465      ! 
     466      ! Stable: 
     467      psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
     468         &       - ABS(1._wp + 2._wp/3._wp*zzeta)**1.5_wp - 2._wp/3._wp*5._wp/0.35_wp + 1._wp 
     469      ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution... 
     470      ! 
     471      stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
     472      ! 
     473      ! 
     474      psi_h_ecmwf(ji,jj) = (1._wp - stab) * psi_unst &   ! (zzeta < 0) Unstable 
     475         &                +    stab    * psi_stab        ! (zzeta > 0) Stable 
     476      ! 
    479477      END_2D 
    480478   END FUNCTION psi_h_ecmwf 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk_algo_ncar.F90

    r12377 r13135  
    112112      REAL(wp), DIMENSION(jpi,jpj) ::   stab          ! stability test integer 
    113113      !!---------------------------------------------------------------------------------- 
    114       ! 
    115       l_zt_equal_zu = .FALSE. 
    116       IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     114      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    117115 
    118116      U_blk = MAX( 0.5_wp , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
    … …  
    143141      ENDIF 
    144142 
    145       !! Initializing values at z_u with z_t values: 
    146       t_zu = t_zt   ;   q_zu = q_zt 
     143      !! First guess of temperature and humidity at height zu: 
     144      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions... 
     145      q_zu = MAX( q_zt , 1.e-6_wp )   !               " 
    147146 
    148147      !! ITERATION BLOCK 

  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk_phy.F90

    r12377 r13135  
    3131   REAL(wp), PARAMETER, PUBLIC :: R_vap   = 461.495_wp  !: Specific gas constant for water vapor          [J/K/kg] 
    3232   REAL(wp), PARAMETER, PUBLIC :: reps0   = R_dry/R_vap !: ratio of gas constant for dry air and water vapor => ~ 0.622 
    33    REAL(wp), PARAMETER, PUBLIC :: rctv0   = R_vap/R_dry !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
     33   REAL(wp), PARAMETER, PUBLIC :: rctv0   = R_vap/R_dry - 1._wp  !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
    3434   REAL(wp), PARAMETER, PUBLIC :: rCp_air = 1000.5_wp   !: specific heat of air (only used for ice fluxes now...) 
    3535   REAL(wp), PARAMETER, PUBLIC :: rCd_ice = 1.4e-3_wp   !: transfer coefficient over ice 
    … …  
    520520         zCe = zz0*pqst(ji,jj)/zdq 
    521521 
    522          CALL BULK_FORMULA( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
    523             &              zCd, zCh, zCe,                                        & 
    524             &              pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                 & 
    525             &              pTau(ji,jj), zQsen, zQlat ) 
    526  
     522         CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
     523            &                    zCd, zCh, zCe,                                       & 
     524            &                    pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                & 
     525            &                    pTau(ji,jj), zQsen, zQlat ) 
     526          
    527527         zTs2  = pTs(ji,jj)*pTs(ji,jj) 
    528528         zQlw  = emiss_w*(prlw(ji,jj) - stefan*zTs2*zTs2) ! Net longwave flux 
    … …  
    535535 
    536536 
    537    SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa,  & 
    538       &                          pCd, pCh, pCe,            & 
    539       &                          pwnd, pUb, pslp,          & 
    540       &                          pTau, pQsen, pQlat,  pEvap, prhoa ) 
     537   SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, & 
     538      &                          pCd, pCh, pCe,           & 
     539      &                          pwnd, pUb, pslp,         & 
     540      &                          pTau, pQsen, pQlat,      & 
     541      &                          pEvap, prhoa, pfact_evap ) 
     542      !!---------------------------------------------------------------------------------- 
     543      REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m) 
     544      REAL(wp), INTENT(in)  :: pTs  ! water temperature at the air-sea interface [K] 
     545      REAL(wp), INTENT(in)  :: pqs  ! satur. spec. hum. at T=pTs   [kg/kg] 
     546      REAL(wp), INTENT(in)  :: pTa  ! potential air temperature at z=pzu [K] 
     547      REAL(wp), INTENT(in)  :: pqa  ! specific humidity at z=pzu [kg/kg] 
     548      REAL(wp), INTENT(in)  :: pCd 
     549      REAL(wp), INTENT(in)  :: pCh 
     550      REAL(wp), INTENT(in)  :: pCe 
     551      REAL(wp), INTENT(in)  :: pwnd ! wind speed module at z=pzu [m/s] 
     552      REAL(wp), INTENT(in)  :: pUb  ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s] 
     553      REAL(wp), INTENT(in)  :: pslp ! sea-level atmospheric pressure [Pa] 
     554      !! 
     555      REAL(wp), INTENT(out) :: pTau  ! module of the wind stress [N/m^2] 
     556      REAL(wp), INTENT(out) :: pQsen !  [W/m^2] 
     557      REAL(wp), INTENT(out) :: pQlat !  [W/m^2] 
     558      !! 
     559      REAL(wp), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s] 
     560      REAL(wp), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3] 
     561      REAL(wp), INTENT(in) , OPTIONAL :: pfact_evap  ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent) 
     562      !! 
     563      REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap 
     564      INTEGER  :: jq 
     565      !!---------------------------------------------------------------------------------- 
     566      zfact_evap = 1._wp 
     567      IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap 
     568       
     569      !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa") 
     570      ztaa = pTa ! first guess... 
     571      DO jq = 1, 4 
     572         zgamma = gamma_moist( 0.5*(ztaa+pTs) , pqa )  !LOLO: why not "0.5*(pqs+pqa)" rather then "pqa" ??? 
     573         ztaa = pTa - zgamma*pzu   ! Absolute temp. is slightly colder... 
     574      END DO 
     575      zrho = rho_air(ztaa, pqa, pslp) 
     576      zrho = rho_air(ztaa, pqa, pslp-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 
     577 
     578      zUrho = pUb*MAX(zrho, 1._wp)     ! rho*U10 
     579 
     580      pTau = zUrho * pCd * pwnd ! Wind stress module 
     581 
     582      zevap = zUrho * pCe * (pqa - pqs) 
     583      pQsen = zUrho * pCh * (pTa - pTs) * cp_air(pqa) 
     584      pQlat = L_vap(pTs) * zevap 
     585 
     586      IF( PRESENT(pEvap) ) pEvap = - zfact_evap * zevap 
     587      IF( PRESENT(prhoa) ) prhoa = zrho 
     588 
     589   END SUBROUTINE BULK_FORMULA_SCLR 
     590 
     591   SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa, & 
     592      &                          pCd, pCh, pCe,           & 
     593      &                          pwnd, pUb, pslp,         & 
     594      &                          pTau, pQsen, pQlat,      &  
     595      &                          pEvap, prhoa, pfact_evap )       
    541596      !!---------------------------------------------------------------------------------- 
    542597      REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m) 
    … …  
    558613      REAL(wp), DIMENSION(jpi,jpj), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s] 
    559614      REAL(wp), DIMENSION(jpi,jpj), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3] 
    560       !! 
    561       REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap 
    562       INTEGER  :: ji, jj, jq     ! dummy loop indices 
    563       !!---------------------------------------------------------------------------------- 
    564       DO_2D_11_11 
    565  
    566          !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa") 
    567          ztaa = pTa(ji,jj) ! first guess... 
    568          DO jq = 1, 4 
    569             zgamma = gamma_moist( 0.5*(ztaa+pTs(ji,jj)) , pqa(ji,jj) ) 
    570             ztaa = pTa(ji,jj) - zgamma*pzu   ! Absolute temp. is slightly colder... 
    571          END DO 
    572          zrho = rho_air(ztaa, pqa(ji,jj), pslp(ji,jj)) 
    573          zrho = rho_air(ztaa, pqa(ji,jj), pslp(ji,jj)-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 
    574  
    575          zUrho = pUb(ji,jj)*MAX(zrho, 1._wp)     ! rho*U10 
    576  
    577          pTau(ji,jj) = zUrho * pCd(ji,jj) * pwnd(ji,jj) ! Wind stress module 
    578  
    579          zevap        = zUrho * pCe(ji,jj) * (pqa(ji,jj) - pqs(ji,jj)) 
    580          pQsen(ji,jj) = zUrho * pCh(ji,jj) * (pTa(ji,jj) - pTs(ji,jj)) * cp_air(pqa(ji,jj)) 
    581          pQlat(ji,jj) = L_vap(pTs(ji,jj)) * zevap 
    582  
    583          IF( PRESENT(pEvap) ) pEvap(ji,jj) = - zevap 
     615      REAL(wp),                     INTENT(in) , OPTIONAL :: pfact_evap  ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent) 
     616      !! 
     617      REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap 
     618      INTEGER  :: ji, jj 
     619      !!---------------------------------------------------------------------------------- 
     620      zfact_evap = 1._wp 
     621      IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap 
     622 
     623      DO_2D_11_11 
     624 
     625         CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
     626            &                    pCd(ji,jj), pCh(ji,jj), pCe(ji,jj),                  & 
     627            &                    pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                & 
     628            &                    pTau(ji,jj), pQsen(ji,jj), pQlat(ji,jj),             & 
     629            &                    pEvap=zevap, prhoa=zrho, pfact_evap=zfact_evap       ) 
     630 
     631         IF( PRESENT(pEvap) ) pEvap(ji,jj) = zevap 
    584632         IF( PRESENT(prhoa) ) prhoa(ji,jj) = zrho 
    585  
     633    
    586634      END_2D 
    587635   END SUBROUTINE BULK_FORMULA_VCTR 
    588  
    589  
    590    SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, & 
    591       &                          pCd, pCh, pCe,           & 
    592       &                          pwnd, pUb, pslp,         & 
    593       &                          pTau, pQsen, pQlat,  pEvap, prhoa ) 
    594       !!---------------------------------------------------------------------------------- 
    595       REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m) 
    596       REAL(wp), INTENT(in)  :: pTs  ! water temperature at the air-sea interface [K] 
    597       REAL(wp), INTENT(in)  :: pqs  ! satur. spec. hum. at T=pTs   [kg/kg] 
    598       REAL(wp), INTENT(in)  :: pTa  ! potential air temperature at z=pzu [K] 
    599       REAL(wp), INTENT(in)  :: pqa  ! specific humidity at z=pzu [kg/kg] 
    600       REAL(wp), INTENT(in)  :: pCd 
    601       REAL(wp), INTENT(in)  :: pCh 
    602       REAL(wp), INTENT(in)  :: pCe 
    603       REAL(wp), INTENT(in)  :: pwnd ! wind speed module at z=pzu [m/s] 
    604       REAL(wp), INTENT(in)  :: pUb  ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s] 
    605       REAL(wp), INTENT(in)  :: pslp ! sea-level atmospheric pressure [Pa] 
    606       !! 
    607       REAL(wp), INTENT(out) :: pTau  ! module of the wind stress [N/m^2] 
    608       REAL(wp), INTENT(out) :: pQsen !  [W/m^2] 
    609       REAL(wp), INTENT(out) :: pQlat !  [W/m^2] 
    610       !! 
    611       REAL(wp), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s] 
    612       REAL(wp), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3] 
    613       !! 
    614       REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap 
    615       INTEGER  :: jq 
    616       !!---------------------------------------------------------------------------------- 
    617  
    618       !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa") 
    619       ztaa = pTa ! first guess... 
    620       DO jq = 1, 4 
    621          zgamma = gamma_moist( 0.5*(ztaa+pTs) , pqa ) 
    622          ztaa = pTa - zgamma*pzu   ! Absolute temp. is slightly colder... 
    623       END DO 
    624       zrho = rho_air(ztaa, pqa, pslp) 
    625       zrho = rho_air(ztaa, pqa, pslp-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 
    626  
    627       zUrho = pUb*MAX(zrho, 1._wp)     ! rho*U10 
    628  
    629       pTau = zUrho * pCd * pwnd ! Wind stress module 
    630  
    631       zevap = zUrho * pCe * (pqa - pqs) 
    632       pQsen = zUrho * pCh * (pTa - pTs) * cp_air(pqa) 
    633       pQlat = L_vap(pTs) * zevap 
    634  
    635       IF( PRESENT(pEvap) ) pEvap = - zevap 
    636       IF( PRESENT(prhoa) ) prhoa = zrho 
    637  
    638    END SUBROUTINE BULK_FORMULA_SCLR 
    639  
    640  
    641636 
    642637