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 9169 for branches/2017/dev_merge_2017/NEMOGCM/NEMO – NEMO

Ignore:
Timestamp:
2017-12-26T17:32:56+01:00 (6 years ago)
Author:
gm
Message:

dev_merge_2017: all SRC: finalize the removal of useless warning when reading namelist_cfg + remove all nn_closea + nn_msh replaced by a logical

Location:
branches/2017/dev_merge_2017/NEMOGCM/NEMO
Files:
83 edited

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icealb.F90

    r9124 r9169  
    193193      REWIND( numnam_ice_ref )              ! Namelist namalb in reference namelist : Albedo parameters 
    194194      READ  ( numnam_ice_ref, namalb, IOSTAT = ios, ERR = 901) 
    195 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namalb in reference namelist', lwp ) 
    196  
     195901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namalb in reference namelist', lwp ) 
    197196      REWIND( numnam_ice_cfg )              ! Namelist namalb in configuration namelist : Albedo parameters 
    198197      READ  ( numnam_ice_cfg, namalb, IOSTAT = ios, ERR = 902 ) 
    199 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namalb in configuration namelist', lwp ) 
    200       IF(lwm) WRITE ( numoni, namalb ) 
     198902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namalb in configuration namelist', lwp ) 
     199      IF(lwm) WRITE( numoni, namalb ) 
    201200      ! 
    202201      IF(lwp) THEN                      ! Control print 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedia.F90

    r9124 r9169  
    180180      REWIND( numnam_ice_ref )      ! Namelist namdia in reference namelist : Parameters for ice 
    181181      READ  ( numnam_ice_ref, namdia, IOSTAT = ios, ERR = 901) 
    182 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdia in reference namelist', lwp ) 
    183  
     182901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdia in reference namelist', lwp ) 
    184183      REWIND( numnam_ice_cfg )      ! Namelist namdia in configuration namelist : Parameters for ice 
    185184      READ  ( numnam_ice_cfg, namdia, IOSTAT = ios, ERR = 902 ) 
    186 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdia in configuration namelist', lwp ) 
     185902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namdia in configuration namelist', lwp ) 
    187186      IF(lwm) WRITE ( numoni, namdia ) 
    188187      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedyn.F90

    r9124 r9169  
    219219      REWIND( numnam_ice_ref )         ! Namelist namdyn in reference namelist : Ice dynamics 
    220220      READ  ( numnam_ice_ref, namdyn, IOSTAT = ios, ERR = 901) 
    221 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn in reference namelist', lwp ) 
    222       ! 
     221901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn in reference namelist', lwp ) 
    223222      REWIND( numnam_ice_cfg )         ! Namelist namdyn in configuration namelist : Ice dynamics 
    224223      READ  ( numnam_ice_cfg, namdyn, IOSTAT = ios, ERR = 902 ) 
    225 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namdyn in configuration namelist', lwp ) 
    226       IF(lwm) WRITE ( numoni, namdyn ) 
     224902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn in configuration namelist', lwp ) 
     225      IF(lwm) WRITE( numoni, namdyn ) 
    227226      ! 
    228227      IF(lwp) THEN                     ! control print 
    … …  
    234233         WRITE(numout,*) '      No ridge/raft & No cor (rhg + adv)                      ln_dynRHGADV = ', ln_dynRHGADV 
    235234         WRITE(numout,*) '      Advection only         (rn_uvice + adv)                 ln_dynADV    = ', ln_dynADV 
    236          WRITE(numout,*) '           with prescribed velocity given by ' 
    237          WRITE(numout,*) '               a uniform field               (u,v)_ice = (rn_uice,rn_vice) = (', rn_uice,',', rn_vice,')' 
     235         WRITE(numout,*) '         with prescribed velocity given by   (u,v)_ice = (rn_uice,rn_vice) = (', rn_uice,',', rn_vice,')' 
    238236         WRITE(numout,*) '      lateral boundary condition for sea ice dynamics         rn_ishlat    = ', rn_ishlat 
    239237         WRITE(numout,*) '      Landfast: param (T or F)                                ln_landfast  = ', ln_landfast 
    … …  
    241239         WRITE(numout,*) '         maximum bottom stress per unit area of contact       rn_icebfr    = ', rn_icebfr 
    242240         WRITE(numout,*) '         relax time scale (s-1) to reach static friction      rn_lfrelax   = ', rn_lfrelax 
     241         WRITE(numout,*) 
    243242      ENDIF 
    244243      !                             !== set the choice of ice dynamics ==! 
    … …  
    260259      ENDIF 
    261260      !                                      !--- NO Landfast ice : set to zero once for all 
    262       IF( .NOT. ln_landfast )   tau_icebfr(:,:) = 0._wp 
     261      IF( .NOT.ln_landfast )   tau_icebfr(:,:) = 0._wp 
    263262      ! 
    264263      CALL ice_dyn_rdgrft_init          ! set ice ridging/rafting parameters 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv.F90

    r9124 r9169  
    138138      REWIND( numnam_ice_ref )         ! Namelist namdyn_adv in reference namelist : Ice dynamics 
    139139      READ  ( numnam_ice_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 
    140 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp ) 
    141       ! 
     140901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp ) 
    142141      REWIND( numnam_ice_cfg )         ! Namelist namdyn_adv in configuration namelist : Ice dynamics 
    143142      READ  ( numnam_ice_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 ) 
    144 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp ) 
    145       IF(lwm) WRITE ( numoni, namdyn_adv ) 
     143902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp ) 
     144      IF(lwm) WRITE( numoni, namdyn_adv ) 
    146145      ! 
    147146      IF(lwp) THEN                     ! control print 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rdgrft.F90

    r9124 r9169  
    891891      REWIND( numnam_ice_ref )              ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution 
    892892      READ  ( numnam_ice_ref, namdyn_rdgrft, IOSTAT = ios, ERR = 901) 
    893 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist', lwp ) 
    894       ! 
     893901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist', lwp ) 
    895894      REWIND( numnam_ice_cfg )              ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution 
    896895      READ  ( numnam_ice_cfg, namdyn_rdgrft, IOSTAT = ios, ERR = 902 ) 
    897 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist', lwp ) 
     896902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist', lwp ) 
    898897      IF(lwm) WRITE ( numoni, namdyn_rdgrft ) 
    899898      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg.F90

    r9124 r9169  
    114114      READ  ( numnam_ice_ref, namdyn_rhg, IOSTAT = ios, ERR = 901) 
    115115901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist', lwp ) 
    116       ! 
    117116      REWIND( numnam_ice_cfg )         ! Namelist namdyn_rhg in configuration namelist : Ice dynamics 
    118117      READ  ( numnam_ice_cfg, namdyn_rhg, IOSTAT = ios, ERR = 902 ) 
    … …  
    124123         WRITE(numout,*) 'ice_dyn_rhg_init: ice parameters for ice dynamics ' 
    125124         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    126          WRITE(numout,*) '   Namelist namdyn_rhg:' 
     125         WRITE(numout,*) '   Namelist : namdyn_rhg:' 
    127126         WRITE(numout,*) '      rheology EVP (icedyn_rhg_evp)                        ln_rhg_EVP = ', ln_rhg_EVP 
    128127         WRITE(numout,*) '         use adaptive EVP (aEVP)                           ln_aEVP    = ', ln_aEVP 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rhg_evp.F90

    r9049 r9169  
    875875               CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i ) 
    876876            ELSE                                     ! start rheology from rest 
    877                IF(lwp) WRITE(numout,*) '   ==>>   previous run without rheology, set stresses to 0' 
     877               IF(lwp) WRITE(numout,*) 
     878               IF(lwp) WRITE(numout,*) '   ==>>>   previous run without rheology, set stresses to 0' 
    878879               stress1_i (:,:) = 0._wp 
    879880               stress2_i (:,:) = 0._wp 
    … …  
    881882            ENDIF 
    882883         ELSE                                   !* Start from rest 
    883             IF(lwp) WRITE(numout,*) '   ==>>   start from rest: set stresses to 0' 
     884            IF(lwp) WRITE(numout,*) 
     885            IF(lwp) WRITE(numout,*) '   ==>>>   start from rest: set stresses to 0' 
    884886            stress1_i (:,:) = 0._wp 
    885887            stress2_i (:,:) = 0._wp 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/iceforcing.F90

    r9124 r9169  
    5252      !!              utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] 
    5353      !!------------------------------------------------------------------- 
    54       INTEGER, INTENT(in) ::   kt      ! ocean time step 
    55       INTEGER, INTENT(in) ::   ksbc    ! type of sbc flux ( 1 = user defined formulation,  
    56                                        !                    3 = bulk formulation, 
    57                                        !                    4 = Pure Coupled formulation) 
    58       REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::   utau_ice, vtau_ice  
     54      INTEGER                     , INTENT(in   ) ::   kt                   ! ocean time step 
     55      INTEGER                     , INTENT(in   ) ::   ksbc                 ! type of sbc flux 
     56      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   utau_ice, vtau_ice   ! air-ice stress   [N/m2] 
    5957      !! 
    6058      INTEGER  ::   ji, jj                 ! dummy loop index 
    6159      REAL(wp), DIMENSION(jpi,jpj) ::   zutau_ice, zvtau_ice  
    6260      !!------------------------------------------------------------------- 
    63  
     61      ! 
    6462      IF( ln_timing )   CALL timing_start('ice_forcing') 
    65  
     63      ! 
    6664      IF( kt == nit000 .AND. lwp ) THEN 
    6765         WRITE(numout,*) 
    … …  
    6967         WRITE(numout,*)'~~~~~~~~~~~~~~~' 
    7068      ENDIF 
    71  
     69      ! 
    7270      SELECT CASE( ksbc ) 
    7371         CASE( jp_usr     )   ;    CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation 
    … …  
    7573         CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled      formulation 
    7674      END SELECT 
    77  
     75      ! 
    7876      IF( ln_mixcpl) THEN                                                        ! Case of a mixed Bulk/Coupled formulation 
    7977                                   CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
    … …  
    8684         CALL lbc_lnk_multi( utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 
    8785      ENDIF 
    88  
     86      ! 
    8987      IF( ln_timing )   CALL timing_stop('ice_forcing') 
    9088      ! 
    … …  
    255253   END SUBROUTINE ice_flx_dist 
    256254 
     255 
    257256   SUBROUTINE ice_forcing_init 
    258257      !!------------------------------------------------------------------- 
    259258      !!                  ***  ROUTINE ice_forcing_init  *** 
    260259      !! 
    261       !! ** Purpose : Physical constants and parameters linked to the ice 
    262       !!      dynamics 
    263       !! 
    264       !! ** Method  :  Read the namforcing namelist and check the ice-dynamic 
    265       !!       parameter values called at the first timestep (nit000) 
     260      !! ** Purpose :   Physical constants and parameters linked to the ice dynamics 
     261      !!       
     262      !! ** Method  :   Read the namforcing namelist and check the ice-dynamic 
     263      !!              parameter values called at the first timestep (nit000) 
    266264      !! 
    267265      !! ** input   :   Namelist namforcing 
    268266      !!------------------------------------------------------------------- 
    269       INTEGER ::   ios, ioptio   ! Local integer output status for namelist read 
     267      INTEGER ::   ios, ioptio   ! Local integer 
    270268      !! 
    271269      NAMELIST/namforcing/ rn_cio, rn_blow_s, nn_flxdist, nice_jules 
    … …  
    274272      REWIND( numnam_ice_ref )         ! Namelist namforcing in reference namelist : Ice dynamics 
    275273      READ  ( numnam_ice_ref, namforcing, IOSTAT = ios, ERR = 901) 
    276 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namforcing in reference namelist', lwp ) 
    277       ! 
     274901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namforcing in reference namelist', lwp ) 
    278275      REWIND( numnam_ice_cfg )         ! Namelist namforcing in configuration namelist : Ice dynamics 
    279276      READ  ( numnam_ice_cfg, namforcing, IOSTAT = ios, ERR = 902 ) 
    280 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namforcing in configuration namelist', lwp ) 
    281       IF(lwm) WRITE ( numoni, namforcing ) 
     277902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namforcing in configuration namelist', lwp ) 
     278      IF(lwm) WRITE( numoni, namforcing ) 
    282279      ! 
    283280      IF(lwp) THEN                     ! control print 
    284281         WRITE(numout,*) 
    285282         WRITE(numout,*) 'ice_forcing_init: ice parameters for ice dynamics ' 
    286          WRITE(numout,*) '~~~~~~~~~~~~~~~' 
     283         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    287284         WRITE(numout,*) '   Namelist namforcing:' 
    288285         WRITE(numout,*) '      drag coefficient for oceanic stress              rn_cio     = ', rn_cio 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/iceistate.F90

    r9019 r9169  
    512512      REWIND( numnam_ice_ref )              ! Namelist namini in reference namelist : Ice initial state 
    513513      READ  ( numnam_ice_ref, namini, IOSTAT = ios, ERR = 901) 
    514 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namini in reference namelist', lwp ) 
    515       ! 
     514901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namini in reference namelist', lwp ) 
    516515      REWIND( numnam_ice_cfg )              ! Namelist namini in configuration namelist : Ice initial state 
    517516      READ  ( numnam_ice_cfg, namini, IOSTAT = ios, ERR = 902 ) 
    518 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namini in configuration namelist', lwp ) 
     517902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namini in configuration namelist', lwp ) 
    519518      IF(lwm) WRITE ( numoni, namini ) 
    520519      ! 
    … …  
    522521      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_tsu) = sn_tsu 
    523522      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_smi) = sn_smi 
    524       ! 
    525523      ! 
    526524      IF(lwp) THEN                          ! control print 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/iceitd.F90

    r9019 r9169  
    657657      REWIND( numnam_ice_ref )      ! Namelist namitd in reference namelist : Parameters for ice 
    658658      READ  ( numnam_ice_ref, namitd, IOSTAT = ios, ERR = 901) 
    659 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist', lwp ) 
    660       ! 
     659901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namitd in reference namelist', lwp ) 
    661660      REWIND( numnam_ice_cfg )      ! Namelist namitd in configuration namelist : Parameters for ice 
    662661      READ  ( numnam_ice_cfg, namitd, IOSTAT = ios, ERR = 902 ) 
    663 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist', lwp ) 
    664       IF(lwm) WRITE ( numoni, namitd ) 
     662902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namitd in configuration namelist', lwp ) 
     663      IF(lwm) WRITE( numoni, namitd ) 
    665664      ! 
    666665      IF(lwp) THEN                  ! control print 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icestp.F90

    r9124 r9169  
    281281      !! ** input   :   Namelist nampar 
    282282      !!------------------------------------------------------------------- 
    283       INTEGER  ::   ios                 ! Local integer output status for namelist read 
     283      INTEGER  ::   ios                 ! Local integer 
     284      !! 
    284285      NAMELIST/nampar/ jpl, nlay_i, nlay_s, nn_virtual_itd, ln_icedyn, ln_icethd, rn_amax_n, rn_amax_s,  & 
    285286         &             cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir 
    … …  
    288289      REWIND( numnam_ice_ref )      ! Namelist nampar in reference namelist : Parameters for ice 
    289290      READ  ( numnam_ice_ref, nampar, IOSTAT = ios, ERR = 901) 
    290 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampar in reference namelist', lwp ) 
    291  
     291901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampar in reference namelist', lwp ) 
    292292      REWIND( numnam_ice_cfg )      ! Namelist nampar in configuration namelist : Parameters for ice 
    293293      READ  ( numnam_ice_cfg, nampar, IOSTAT = ios, ERR = 902 ) 
    294 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampar in configuration namelist', lwp ) 
    295       IF(lwm) WRITE ( numoni, nampar ) 
     294902   IF( ios > 0 )  CALL ctl_nam ( ios , 'nampar in configuration namelist', lwp ) 
     295      IF(lwm) WRITE( numoni, nampar ) 
    296296      ! 
    297297      IF(lwp) THEN                  ! control print 
    298298         WRITE(numout,*) 
    299          WRITE(numout,*) 'par_init: ice parameters shared among all the routines' 
    300          WRITE(numout,*) ' ~~~~~~~' 
    301          WRITE(numout,*) '   Namelist nampar: ' 
    302          WRITE(numout,*) '      number of ice  categories                              jpl    = ', jpl 
    303          WRITE(numout,*) '      number of ice  layers                                  nlay_i = ', nlay_i 
    304          WRITE(numout,*) '      number of snow layers                                  nlay_s = ', nlay_s 
    305          WRITE(numout,*) '      virtual ITD param for jpl=1 (1-3) or not (0)   nn_virtual_itd = ', nn_virtual_itd 
    306          WRITE(numout,*) '      Ice dynamics       (T) or not (F)                   ln_icedyn = ', ln_icedyn 
    307          WRITE(numout,*) '      Ice thermodynamics (T) or not (F)                   ln_icethd = ', ln_icethd 
    308          WRITE(numout,*) '      maximum ice concentration for NH                              = ', rn_amax_n  
    309          WRITE(numout,*) '      maximum ice concentration for SH                              = ', rn_amax_s 
     299         WRITE(numout,*) '   par_init: ice parameters shared among all the routines' 
     300         WRITE(numout,*) '   ~~~~~~~~' 
     301         WRITE(numout,*) '      Namelist nampar: ' 
     302         WRITE(numout,*) '         number of ice  categories                           jpl       = ', jpl 
     303         WRITE(numout,*) '         number of ice  layers                               nlay_i    = ', nlay_i 
     304         WRITE(numout,*) '         number of snow layers                               nlay_s    = ', nlay_s 
     305         WRITE(numout,*) '         virtual ITD param for jpl=1 (1-3) or not (0)   nn_virtual_itd = ', nn_virtual_itd 
     306         WRITE(numout,*) '         Ice dynamics       (T) or not (F)                   ln_icedyn = ', ln_icedyn 
     307         WRITE(numout,*) '         Ice thermodynamics (T) or not (F)                   ln_icethd = ', ln_icethd 
     308         WRITE(numout,*) '         maximum ice concentration for NH                              = ', rn_amax_n  
     309         WRITE(numout,*) '         maximum ice concentration for SH                              = ', rn_amax_s 
    310310      ENDIF 
    311       ! 
    312311      !                                        !--- check consistency 
    313312      IF ( jpl > 1 .AND. nn_virtual_itd == 1 ) THEN 
    … …  
    323322      IF( ln_bdy .AND. ln_icediachk )   CALL ctl_warn('par_init: online conservation check does not work with BDY') 
    324323      ! 
    325       rdt_ice   = REAL(nn_fsbc) * rdt          !--- sea-ice timestep and inverse 
     324      rdt_ice   = REAL(nn_fsbc) * rdt          !--- sea-ice timestep and its inverse 
    326325      r1_rdtice = 1._wp / rdt_ice 
    327       IF( lwp ) WRITE(numout,*) '   ice timestep rdt_ice = ', rdt_ice 
     326      IF(lwp) WRITE(numout,*) 
     327      IF(lwp) WRITE(numout,*) '      ice timestep rdt_ice = nn_fsbc*rdt = ', rdt_ice 
    328328      ! 
    329329      r1_nlay_i = 1._wp / REAL( nlay_i, wp )   !--- inverse of nlay_i and nlay_s 
    … …  
    356356         h_s_b(:,:,:) = 0._wp 
    357357      END WHERE 
    358        
     358      ! 
    359359      ! ice velocities & total concentration 
    360360      at_i_b(:,:)  = SUM( a_i_b(:,:,:), dim=3 ) 
    … …  
    412412      tau_icebfr(:,:)   = 0._wp   ! landfast ice param only (clem: important to keep the init here) 
    413413      cnd_ice   (:,:,:) = 0._wp   ! initialisation of the effective conductivity at the top of ice/snow (Jules coupling) 
    414        
     414      ! 
    415415   END SUBROUTINE diag_set0 
    416416 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icethd.F90

    r9124 r9169  
    564564      REWIND( numnam_ice_ref )              ! Namelist namthd in reference namelist : Ice thermodynamics 
    565565      READ  ( numnam_ice_ref, namthd, IOSTAT = ios, ERR = 901) 
    566 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd in reference namelist', lwp ) 
    567  
     566901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd in reference namelist', lwp ) 
    568567      REWIND( numnam_ice_cfg )              ! Namelist namthd in configuration namelist : Ice thermodynamics 
    569568      READ  ( numnam_ice_cfg, namthd, IOSTAT = ios, ERR = 902 ) 
    570 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namthd in configuration namelist', lwp ) 
    571       IF(lwm) WRITE ( numoni, namthd ) 
    572       ! 
     569902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd in configuration namelist', lwp ) 
     570      IF(lwm) WRITE( numoni, namthd ) 
    573571      ! 
    574572      IF(lwp) THEN                          ! control print 
     573         WRITE(numout,*) 
    575574         WRITE(numout,*) 'ice_thd_init: Ice Thermodynamics' 
    576575         WRITE(numout,*) '~~~~~~~~~~~~' 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icethd_da.F90

    r9019 r9169  
    1010   !!   'key_lim3'                                       ESIM sea-ice model 
    1111   !!---------------------------------------------------------------------- 
    12    !!   ice_thd_da        : sea ice lateral melting 
    13    !!   ice_thd_da_init   : sea ice lateral melting initialization 
     12   !!   ice_thd_da      : sea ice lateral melting 
     13   !!   ice_thd_da_init : sea ice lateral melting initialization 
    1414   !!---------------------------------------------------------------------- 
    1515   USE par_oce        ! ocean parameters 
    … …  
    2828   PUBLIC   ice_thd_da_init   ! called by icestp.F90 
    2929 
    30    ! ** namelist (namthd_da) ** 
    31    REAL(wp) ::   rn_beta     ! coef. beta for lateral melting param. 
    32    REAL(wp) ::   rn_dmin     ! minimum floe diameter for lateral melting param. 
     30   !                      !!** namelist (namthd_da) ** 
     31   REAL(wp) ::   rn_beta   ! coef. beta for lateral melting param. 
     32   REAL(wp) ::   rn_dmin   ! minimum floe diameter for lateral melting param. 
    3333 
    3434   !!---------------------------------------------------------------------- 
    … …  
    118118      ! 
    119119      zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) ) 
     120      ! 
    120121      DO ji = 1, npti    
    121122         ! --- Calculate reduction of total sea ice concentration --- ! 
    … …  
    157158   END SUBROUTINE ice_thd_da 
    158159 
     160 
    159161   SUBROUTINE ice_thd_da_init 
    160162      !!----------------------------------------------------------------------- 
    … …  
    169171      !! ** input   :   Namelist namthd_da 
    170172      !!------------------------------------------------------------------- 
    171       INTEGER  ::   ios   ! Local integer output status for namelist read 
     173      INTEGER  ::   ios   ! Local integer 
    172174      !! 
    173175      NAMELIST/namthd_da/ rn_beta, rn_dmin 
    … …  
    176178      REWIND( numnam_ice_ref )              ! Namelist namthd_da in reference namelist : Ice thermodynamics 
    177179      READ  ( numnam_ice_ref, namthd_da, IOSTAT = ios, ERR = 901) 
    178 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_da in reference namelist', lwp ) 
    179  
     180901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_da in reference namelist', lwp ) 
    180181      REWIND( numnam_ice_cfg )              ! Namelist namthd_da in configuration namelist : Ice thermodynamics 
    181182      READ  ( numnam_ice_cfg, namthd_da, IOSTAT = ios, ERR = 902 ) 
    182 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_da in configuration namelist', lwp ) 
    183       IF(lwm) WRITE ( numoni, namthd_da ) 
    184       ! 
     183902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_da in configuration namelist', lwp ) 
     184      IF(lwm) WRITE( numoni, namthd_da ) 
    185185      ! 
    186186      IF(lwp) THEN                          ! control print 
     187         WRITE(numout,*) 
    187188         WRITE(numout,*) 'ice_thd_da_init: Ice lateral melting' 
    188189         WRITE(numout,*) '~~~~~~~~~~~~~~~' 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icethd_do.F90

    r9019 r9169  
    3939   PUBLIC   ice_thd_do_init   ! called by ice_stp 
    4040 
    41    ! ** namelist (namthd_do) ** 
    42    REAL(wp) ::   rn_hinew         ! thickness for new ice formation (m) 
    43    LOGICAL  ::   ln_frazil        ! use of frazil ice collection as function of wind (T) or not (F) 
    44    REAL(wp) ::   rn_maxfraz       ! maximum portion of frazil ice collecting at the ice bottom 
    45    REAL(wp) ::   rn_vfraz         ! threshold drift speed for collection of bottom frazil ice 
    46    REAL(wp) ::   rn_Cfraz         ! squeezing coefficient for collection of bottom frazil ice 
     41   !                          !!** namelist (namthd_do) ** 
     42   REAL(wp) ::   rn_hinew      ! thickness for new ice formation (m) 
     43   LOGICAL  ::   ln_frazil     ! use of frazil ice collection as function of wind (T) or not (F) 
     44   REAL(wp) ::   rn_maxfraz    ! maximum portion of frazil ice collecting at the ice bottom 
     45   REAL(wp) ::   rn_vfraz      ! threshold drift speed for collection of bottom frazil ice 
     46   REAL(wp) ::   rn_Cfraz      ! squeezing coefficient for collection of bottom frazil ice 
    4747 
    4848   !!---------------------------------------------------------------------- 
    … …  
    7878      !!               update h_s_1d, h_i_1d       
    7979      !!------------------------------------------------------------------------ 
    80       INTEGER  ::   ji,jj,jk,jl      ! dummy loop indices 
     80      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    8181      INTEGER  ::   iter     !   -       - 
    8282      REAL(wp) ::   ztmelts, zfrazb, zweight, zde                          ! local scalars 
    8383      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf                     !   -      - 
    8484      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      - 
    85  
     85      ! 
    8686      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean) 
    8787      REAL(wp) ::   zEi          ! sea ice specific enthalpy (J/kg) 
    8888      REAL(wp) ::   zEw          ! seawater specific enthalpy (J/kg) 
    8989      REAL(wp) ::   zfmdt        ! mass flux x time step (kg/m2, >0 towards ocean) 
    90       
     90      ! 
    9191      REAL(wp) ::   zv_newfra 
    92    
     92      ! 
    9393      INTEGER , DIMENSION(jpij) ::   jcat        ! indexes of categories where new ice grows 
    9494      REAL(wp), DIMENSION(jpij) ::   zswinew     ! switch for new ice or not 
    95  
     95      ! 
    9696      REAL(wp), DIMENSION(jpij) ::   zv_newice   ! volume of accreted ice 
    9797      REAL(wp), DIMENSION(jpij) ::   za_newice   ! fractional area of accreted ice 
    … …  
    104104      REAL(wp), DIMENSION(jpij) ::   zv_frazb    ! accretion of frazil ice at the ice bottom 
    105105      REAL(wp), DIMENSION(jpij) ::   zvrel_1d    ! relative ice / frazil velocity (1D vector) 
    106  
     106      ! 
    107107      REAL(wp), DIMENSION(jpij,jpl) ::   zv_b      ! old volume of ice in category jl 
    108108      REAL(wp), DIMENSION(jpij,jpl) ::   za_b      ! old area of ice in category jl 
    109  
     109      ! 
    110110      REAL(wp), DIMENSION(jpij,nlay_i,jpl) ::   ze_i_2d !: 1-D version of e_i 
    111  
     111      ! 
    112112      REAL(wp), DIMENSION(jpi,jpj) ::   zvrel     ! relative ice / frazil velocity 
    113  
     113      ! 
    114114      REAL(wp) :: zcai = 1.4e-3_wp                     ! ice-air drag (clem: should be dependent on coupling/forcing used) 
    115115      !!-----------------------------------------------------------------------! 
    116116 
    117       IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
     117      IF( ln_icediachk )   CALL ice_cons_hsm( 0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft ) 
    118118 
    119119      CALL ice_var_agg(1) 
    … …  
    141141 
    142142      IF( ln_frazil ) THEN 
    143  
     143         ! 
    144144         !-------------------- 
    145145         ! Physical constants 
    146146         !-------------------- 
    147147         ht_i_new(:,:) = 0._wp 
    148  
     148         ! 
    149149         zhicrit = 0.04 ! frazil ice thickness 
    150150         ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav 
    151151         zsqcd   = 1.0 / SQRT( 1.3 * zcai ) ! 1/SQRT(airdensity*drag) 
    152152         zgamafr = 0.03 
    153  
     153         ! 
    154154         DO jj = 2, jpjm1 
    155155            DO ji = 2, jpim1 
    … …  
    204204                     iter = iter + 1 
    205205                  END DO 
    206  
     206                  ! 
    207207               ENDIF ! end of selection of pixels where ice forms 
    208  
     208               ! 
    209209            END DO  
    210210         END DO  
    … …  
    222222      !------------------------------------- 
    223223      ! This occurs if open water energy budget is negative (cooling) and there is no landfast ice 
    224       npti = 0 ; nptidx(:) = 0 
     224      npti = 0   ;  nptidx(:) = 0 
    225225      DO jj = 1, jpj 
    226226         DO ji = 1, jpi 
    … …  
    431431               h_i_old (ji,nlay_i+1) = zv_newfra 
    432432               eh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra 
    433             ENDDO 
     433            END DO 
    434434            ! --- Ice enthalpy remapping --- ! 
    435435            CALL ice_thd_ent( ze_i_2d(1:npti,:,jl) )  
    436          ENDDO 
     436         END DO 
    437437 
    438438         !----------------- 
    … …  
    474474      ! 
    475475   END SUBROUTINE ice_thd_do 
     476 
    476477 
    477478   SUBROUTINE ice_thd_do_init 
    … …  
    487488      !! ** input   :   Namelist namthd_do 
    488489      !!------------------------------------------------------------------- 
    489       INTEGER  ::   ios   ! Local integer output status for namelist read 
     490      INTEGER  ::   ios   ! Local integer  
    490491      !! 
    491492      NAMELIST/namthd_do/ rn_hinew, ln_frazil, rn_maxfraz, rn_vfraz, rn_Cfraz 
    … …  
    494495      REWIND( numnam_ice_ref )              ! Namelist namthd_do in reference namelist : Ice thermodynamics 
    495496      READ  ( numnam_ice_ref, namthd_do, IOSTAT = ios, ERR = 901) 
    496 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_do in reference namelist', lwp ) 
    497  
     497901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_do in reference namelist', lwp ) 
    498498      REWIND( numnam_ice_cfg )              ! Namelist namthd_do in configuration namelist : Ice thermodynamics 
    499499      READ  ( numnam_ice_cfg, namthd_do, IOSTAT = ios, ERR = 902 ) 
    500 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_do in configuration namelist', lwp ) 
    501       IF(lwm) WRITE ( numoni, namthd_do ) 
    502       ! 
     500902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_do in configuration namelist', lwp ) 
     501      IF(lwm) WRITE( numoni, namthd_do ) 
    503502      ! 
    504503      IF(lwp) THEN                          ! control print 
     504         WRITE(numout,*) 
    505505         WRITE(numout,*) 'ice_thd_do_init: Ice growth in open water' 
    506506         WRITE(numout,*) '~~~~~~~~~~~~~~~' 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icethd_pnd.F90

    r9019 r9169  
    1212   !!   'key_lim3' :                                     ESIM sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    !!   ice_thd_pnd_init      : some initialization and namelist read 
    15    !!   ice_thd_pnd           : main calling routine 
     14   !!   ice_thd_pnd_init : some initialization and namelist read 
     15   !!   ice_thd_pnd      : main calling routine 
    1616   !!---------------------------------------------------------------------- 
    1717   USE phycst         ! physical constants 
    … …  
    3232   PUBLIC   ice_thd_pnd         ! routine called by icestp.F90 
    3333 
    34    INTEGER ::              nice_pnd   ! choice of the type of pond scheme 
    35    !                                               ! associated indices: 
     34   INTEGER ::              nice_pnd    ! choice of the type of pond scheme 
     35   !                                   ! associated indices: 
    3636   INTEGER, PARAMETER ::   np_pndNO  = 0   ! No pond scheme 
    3737   INTEGER, PARAMETER ::   np_pndCST = 1   ! Constant pond scheme 
    … …  
    5454      !!                 
    5555      !! ** Method  :   brut force 
    56       !! 
    57       !! ** Action  : -  
    58       !!              -  
    59       !!------------------------------------------------------------------- 
    60  
     56      !!------------------------------------------------------------------- 
     57      ! 
    6158      SELECT CASE ( nice_pnd ) 
    62  
    63       CASE (np_pndCST) 
    64          !                             !-------------------------------! 
    65          CALL pnd_CST                  ! Constant melt ponds           ! 
    66          !                             !-------------------------------! 
    67       CASE (np_pndH12) 
    68          !                             !-------------------------------! 
    69          CALL pnd_H12                  ! Holland et al 2012 melt ponds ! 
    70          !                             !-------------------------------! 
     59      ! 
     60      CASE (np_pndCST)   ;   CALL pnd_CST    !==  Constant melt ponds  ==! 
     61         ! 
     62      CASE (np_pndH12)   ;   CALL pnd_H12    !==  Holland et al 2012 melt ponds  ==! 
     63         ! 
    7164      END SELECT 
    72  
     65      ! 
    7366   END SUBROUTINE ice_thd_pnd  
    7467 
     68 
    7569   SUBROUTINE pnd_CST  
    7670      !!------------------------------------------------------------------- 
    7771      !!                ***  ROUTINE pnd_CST  *** 
    7872      !! 
    79       !! ** Purpose    : Compute melt pond evolution 
    80       !! 
    81       !! ** Method     : Melt pond fraction and thickness are prescribed  
    82       !!                 to non-zero values when t_su = 0C 
     73      !! ** Purpose :  Compute melt pond evolution 
     74      !! 
     75      !! ** Method  :  Melt pond fraction and thickness are prescribed  
     76      !!              to non-zero values when t_su = 0C 
    8377      !! 
    8478      !! ** Tunable parameters : pond fraction (rn_apnd), pond depth (rn_hpnd) 
    8579      !!                 
    86       !! ** Note       : Coupling with such melt ponds is only radiative 
    87       !!                 Advection, ridging, rafting... are bypassed 
     80      !! ** Note   : Coupling with such melt ponds is only radiative 
     81      !!         Advection, ridging, rafting... are bypassed 
    8882      !! 
    8983      !! ** References : Bush, G.W., and Trump, D.J. (2017) 
    90       !!     
    9184      !!------------------------------------------------------------------- 
    9285      INTEGER  ::   ji        ! loop indices 
    9386      !!------------------------------------------------------------------- 
    9487      DO ji = 1, npti 
    95           
     88         ! 
    9689         IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN 
    9790            a_ip_frac_1d(ji) = rn_apnd 
    … …  
    10396            a_ip_1d(ji)      = 0._wp 
    10497         ENDIF 
    105           
     98         ! 
    10699      END DO 
    107        
     100      ! 
    108101   END SUBROUTINE pnd_CST 
     102 
    109103 
    110104   SUBROUTINE pnd_H12 
    … …  
    130124      !! 
    131125      !! ** References : Holland, M. M. et al (J Clim 2012) 
    132       !!     
    133126      !!------------------------------------------------------------------- 
    134127      REAL(wp), PARAMETER ::   zrmin       = 0.15_wp  ! minimum fraction of available meltwater retained for melt ponding 
    135       REAL(wp), PARAMETER ::   zrmax       = 0.70_wp  ! maximum   ''           ''       ''        ''            '' 
     128      REAL(wp), PARAMETER ::   zrmax       = 0.70_wp  ! maximum     -           -         -         -            - 
    136129      REAL(wp), PARAMETER ::   zpnd_aspect = 0.8_wp   ! pond aspect ratio 
    137130      REAL(wp), PARAMETER ::   zTp         = -2._wp   ! reference temperature 
    138  
     131      ! 
    139132      REAL(wp) ::   zfr_mlt          ! fraction of available meltwater retained for melt ponding 
    140133      REAL(wp) ::   zdv_mlt          ! available meltwater for melt ponding 
    … …  
    143136      REAL(wp) ::   z1_zpnd_aspect   ! inverse pond aspect ratio 
    144137      REAL(wp) ::   zfac, zdum 
    145  
     138      ! 
    146139      INTEGER  ::   ji   ! loop indices 
    147140      !!------------------------------------------------------------------- 
    148       z1_rhofw       = 1. / rhofw  
    149       z1_zpnd_aspect = 1. / zpnd_aspect 
     141      z1_rhofw       = 1._wp / rhofw  
     142      z1_zpnd_aspect = 1._wp / zpnd_aspect 
    150143      z1_Tp          = 1._wp / zTp  
    151144 
    … …  
    162155            !                                                     !--------------------------------! 
    163156            v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! record pond volume at previous time step 
    164  
     157            ! 
    165158            ! available meltwater for melt ponding [m, >0] and fraction 
    166159            zdv_mlt = -( dh_i_surf(ji)*rhoic + dh_s_mlt(ji)*rhosn ) * z1_rhofw * a_i_1d(ji) 
    167160            zfr_mlt = zrmin + ( zrmax - zrmin ) * a_i_1d(ji)  ! from CICE doc 
    168161            !zfr_mlt = zrmin + zrmax * a_i_1d(ji)             ! from Holland paper  
    169  
     162            ! 
    170163            !--- Pond gowth ---! 
    171164            ! v_ip should never be negative, otherwise code crashes 
    172165            ! MV: as far as I saw, UM5 can create very small negative v_ip values (not Prather) 
    173166            v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zfr_mlt * zdv_mlt ) 
    174  
     167            ! 
    175168            ! melt pond mass flux (<0) 
    176169            IF( ln_pnd_fwb .AND. zdv_mlt > 0._wp ) THEN 
    177170               zfac = zfr_mlt * zdv_mlt * rhofw * r1_rdtice 
    178171               wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac 
    179  
     172               ! 
    180173               ! adjust ice/snow melting flux to balance melt pond flux (>0) 
    181174               zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) ) 
    … …  
    183176               wfx_sum_1d(ji)     = wfx_sum_1d(ji)     * (1._wp + zdum) 
    184177            ENDIF 
    185  
     178            ! 
    186179            !--- Pond contraction (due to refreezing) ---! 
    187180            v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) * z1_Tp ) 
    188  
     181            ! 
    189182            ! Set new pond area and depth assuming linear relation between h_ip and a_ip_frac 
    190183            !    h_ip = zpnd_aspect * a_ip_frac = zpnd_aspect * a_ip/a_i 
    … …  
    192185            a_ip_frac_1d(ji) = a_ip_1d(ji) / a_i_1d(ji) 
    193186            h_ip_1d(ji)      = zpnd_aspect * a_ip_frac_1d(ji) 
    194  
     187            ! 
    195188         ENDIF 
    196189      END DO 
    197  
     190      ! 
    198191   END SUBROUTINE pnd_H12 
     192 
    199193 
    200194   SUBROUTINE ice_thd_pnd_init  
    … …  
    210204      !! ** input   :   Namelist namthd_pnd   
    211205      !!------------------------------------------------------------------- 
    212       INTEGER  ::   ios, ioptio                 ! Local integer output status for namelist read 
     206      INTEGER  ::   ios, ioptio   ! Local integer 
     207      !! 
    213208      NAMELIST/namthd_pnd/  ln_pnd_H12, ln_pnd_fwb, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb 
    214209      !!------------------------------------------------------------------- 
    215  
     210      ! 
    216211      REWIND( numnam_ice_ref )              ! Namelist namthd_pnd  in reference namelist : Melt Ponds   
    217212      READ  ( numnam_ice_ref, namthd_pnd, IOSTAT = ios, ERR = 901) 
    218 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_pnd  in reference namelist', lwp ) 
    219  
     213901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_pnd  in reference namelist', lwp ) 
    220214      REWIND( numnam_ice_cfg )              ! Namelist namthd_pnd  in configuration namelist : Melt Ponds 
    221215      READ  ( numnam_ice_cfg, namthd_pnd, IOSTAT = ios, ERR = 902 ) 
    222 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist', lwp ) 
     216902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist', lwp ) 
    223217      IF(lwm) WRITE ( numoni, namthd_pnd ) 
    224        
     218      ! 
    225219      IF(lwp) THEN                        ! control print 
    226220         WRITE(numout,*) 
    … …  
    242236      IF( ln_pnd_H12 ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndH12    ;   ENDIF 
    243237      IF( ioptio > 1 )   CALL ctl_stop( 'ice_thd_pnd_init: choose one and only one pond scheme (ln_pnd_H12 or ln_pnd_CST)' ) 
    244  
     238      ! 
    245239      SELECT CASE( nice_pnd ) 
    246240      CASE( np_pndNO )          

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icethd_sal.F90

    r9019 r9169  
    1212   !!   'key_lim3'                                       ESIM sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    !!   ice_thd_sal        : salinity variations in the ice 
    15    !!   ice_thd_sal_init   : initialization 
     14   !!   ice_thd_sal      : salinity variations in the ice 
     15   !!   ice_thd_sal_init : initialization 
    1616   !!---------------------------------------------------------------------- 
    1717   USE dom_oce        ! ocean space and time domain 
    … …  
    3232    
    3333   ! ** namelist (namthd_sal) ** 
    34    REAL(wp) ::   rn_sal_gd        ! restoring salinity for gravity drainage [PSU] 
    35    REAL(wp) ::   rn_time_gd       ! restoring time constant for gravity drainage (= 20 days) [s] 
    36    REAL(wp) ::   rn_sal_fl        ! restoring salinity for flushing [PSU] 
    37    REAL(wp) ::   rn_time_fl       ! restoring time constant for gravity drainage (= 10 days) [s] 
     34   REAL(wp) ::   rn_sal_gd     ! restoring salinity for gravity drainage [PSU] 
     35   REAL(wp) ::   rn_time_gd    ! restoring time constant for gravity drainage (= 20 days) [s] 
     36   REAL(wp) ::   rn_sal_fl     ! restoring salinity for flushing [PSU] 
     37   REAL(wp) ::   rn_time_fl    ! restoring time constant for gravity drainage (= 10 days) [s] 
    3838 
    3939   !!---------------------------------------------------------------------- 
    … …  
    5656      !!--------------------------------------------------------------------- 
    5757      LOGICAL, INTENT(in) ::   ld_sal            ! gravity drainage and flushing or not  
     58      ! 
    5859      INTEGER  ::   ji, jk                       ! dummy loop indices  
    5960      REAL(wp) ::   iflush, igravdr              ! local scalars 
    … …  
    6667      !               !---------------------------------------------! 
    6768      CASE( 2 )       !  time varying salinity with linear profile  ! 
    68       !               !---------------------------------------------! 
     69         !            !---------------------------------------------! 
    6970         z1_time_gd = 1._wp / rn_time_gd * rdt_ice 
    7071         z1_time_fl = 1._wp / rn_time_fl * rdt_ice 
    7172         ! 
    7273         DO ji = 1, npti 
    73  
     74            ! 
    7475            !--------------------------------------------------------- 
    7576            !  Update ice salinity from snow-ice and bottom growth 
    … …  
    8283               s_i_1d(ji) = s_i_1d(ji) + zs_i_bg + zs_i_si 
    8384            ENDIF 
    84  
     85            ! 
    8586            IF( ld_sal ) THEN 
    8687               !--------------------------------------------------------- 
    … …  
    100101            ENDIF 
    101102         END DO 
    102  
     103         ! 
    103104         ! Salinity profile 
    104105         CALL ice_var_salprof1d 
    105106         ! 
    106       !         !---------------------------------------------! 
    107       CASE( 3 ) ! constant salinity with a fixed profile      ! (Schwarzacher (1959) multiyear salinity profile(mean = 2.30) 
    108       !         !---------------------------------------------! 
     107         !             !----------------------------------------! 
     108      CASE( 3 )        ! constant salinity with a fixed profile ! (Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
     109         !             !----------------------------------------! 
    109110         CALL ice_var_salprof1d 
     111         ! 
     112      END SELECT 
    110113      ! 
    111    END SELECT 
    112    ! 
    113114   END SUBROUTINE ice_thd_sal 
    114115 
    … …  
    125126      !! ** input   :   Namelist namthd_sal 
    126127      !!------------------------------------------------------------------- 
    127       INTEGER  ::   ios                 ! Local integer output status for namelist read 
     128      INTEGER  ::   ios   ! Local integer 
    128129      !! 
    129130      NAMELIST/namthd_sal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd,   & 
    … …  
    133134      REWIND( numnam_ice_ref )              ! Namelist namthd_sal in reference namelist : Ice salinity 
    134135      READ  ( numnam_ice_ref, namthd_sal, IOSTAT = ios, ERR = 901) 
    135 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_sal in reference namelist', lwp ) 
    136       ! 
     136901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_sal in reference namelist', lwp ) 
    137137      REWIND( numnam_ice_cfg )              ! Namelist namthd_sal in configuration namelist : Ice salinity 
    138138      READ  ( numnam_ice_cfg, namthd_sal, IOSTAT = ios, ERR = 902 ) 
    139 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_sal in configuration namelist', lwp ) 
     139902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namthd_sal in configuration namelist', lwp ) 
    140140      IF(lwm) WRITE ( numoni, namthd_sal ) 
    141141      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icethd_zdf.F90

    r9124 r9169  
    100100      REWIND( numnam_ice_ref )              ! Namelist namthd_zdf in reference namelist : Ice thermodynamics 
    101101      READ  ( numnam_ice_ref, namthd_zdf, IOSTAT = ios, ERR = 901) 
    102 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_zdf in reference namelist', lwp ) 
    103  
     102901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_zdf in reference namelist', lwp ) 
    104103      REWIND( numnam_ice_cfg )              ! Namelist namthd_zdf in configuration namelist : Ice thermodynamics 
    105104      READ  ( numnam_ice_cfg, namthd_zdf, IOSTAT = ios, ERR = 902 ) 
    106 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist', lwp ) 
    107       IF(lwm) WRITE ( numoni, namthd_zdf ) 
    108       ! 
     105902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist', lwp ) 
     106      IF(lwm) WRITE( numoni, namthd_zdf ) 
    109107      ! 
    110108      IF(lwp) THEN                          ! control print 
     109         WRITE(numout,*) 
    111110         WRITE(numout,*) 'ice_thd_zdf_init: Ice vertical heat diffusion' 
    112111         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r9167 r9169  
    2424   ! 
    2525   IF( .NOT. Agrif_Root() ) THEN 
    26       jpni = Agrif_Parent(jpni) 
    27       jpnj = Agrif_Parent(jpnj) 
     26      jpni  = Agrif_Parent(jpni) 
     27      jpnj  = Agrif_Parent(jpnj) 
    2828      jpnij = Agrif_Parent(jpnij) 
    29       jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    30       jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    31       jpi     = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls 
    32       jpj     = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls 
     29      jpiglo = nbcellsx + 2 + 2*nbghostcells 
     30      jpjglo = nbcellsy + 2 + 2*nbghostcells 
     31      jpi    = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls 
     32      jpj    = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls 
    3333! JC: change to allow for different vertical levels 
    3434!     jpk is already set 
    … …  
    3636!     hold parent grid vertical levels number (set earlier) 
    3737!      jpk     = jpkglo  
    38       jpim1   = jpi-1  
    39       jpjm1   = jpj-1  
    40       jpkm1   = MAX( 1, jpk-1 )                                          
    41       jpij    = jpi*jpj  
    42       nperio  = 0 
    43       jperio  = 0 
     38      jpim1  = jpi-1  
     39      jpjm1  = jpj-1  
     40      jpkm1  = MAX( 1, jpk-1 )                                          
     41      jpij   = jpi*jpj  
     42      nperio = 0 
     43      jperio = 0 
    4444   ENDIF 
    4545   ! 
    … …  
    780780   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom 
    781781   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 
    782 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 
    783  
     782901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 
    784783   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom 
    785784   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 
    786 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp ) 
     785902 IF( ios >  0 )  CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp ) 
    787786   IF(lwm) WRITE ( numond, namagrif ) 
    788787   ! 
    … …  
    796795      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
    797796      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
    798       WRITE(numout,*)  
    799797   ENDIF 
    800798   ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r9125 r9169  
    234234      REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data 
    235235      READ  ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901) 
    236 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp ) 
    237  
     236901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp ) 
    238237      REWIND( numnam_cfg )              ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data 
    239238      READ  ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 ) 
    240 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist', lwp ) 
     239902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist', lwp ) 
    241240      IF(lwm) WRITE ( numond, namdta_dyn ) 
    242241      !                                         ! store namelist information in an array 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r9124 r9169  
    174174      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
    175175      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    176 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    177  
     176901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    178177      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark 
    179178      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    180 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
     179902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    181180 
    182181      ! 
    183182      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark 
    184183      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    185 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    186  
     184903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    187185      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark 
    188186      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    189 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
     187904   IF( ios >  0 )  CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    190188 
    191189 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r9168 r9169  
    421421            ! keep full control of the configuration namelist 
    422422            READ  ( numnam_cfg, nambdy_index, IOSTAT = ios, ERR = 904 ) 
    423 904         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_index in configuration namelist', lwp ) 
     423904         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_index in configuration namelist', lwp ) 
    424424            IF(lwm) WRITE ( numond, nambdy_index ) 
    425425 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90

    r9168 r9169  
    5959      REAL(wp) , DIMENSION(jpidta,jpjdta) ::  gphidta, glamdta, zdist ! Global lat/lon 
    6060      !! 
    61       NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   & 
    62          &             rn_atfp     , rn_rdt      ,nn_closea , ln_crs,  jphgr_msh, & 
     61      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, ln_meshmask, rn_hmin,   & 
     62         &             rn_atfp     , rn_rdt , ln_crs,  jphgr_msh, & 
    6363         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & 
    6464         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 
    … …  
    6969      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 901 ) 
    7070901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 
    71       ! 
    7271      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 
    7372      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 902 ) 
    … …  
    182181      jpjzoom = iloc(2) + njmpp - 2  ! corner index of the zoom domain. 
    183182 
    184       IF (lwp) THEN 
     183      IF(lwp) THEN 
    185184         WRITE(numout,*) 
    186185         WRITE(numout,*) 'dom_c1d : compute jpizoom & jpjzoom from global mesh and given coordinates' 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90

    r9019 r9169  
    122122                                                !: 1 = binning centers at equator (north fold my have artifacts)      
    123123                                                !:    for even reduction factors, equator placed in bin biased south 
    124       INTEGER           :: nn_msh_crs = 1       !: Organization of mesh mask output 
    125                                                 !: 0 = no mesh mask output 
    126                                                 !: 1 = unified mesh mask output 
    127                                                 !: 2 = 2 separate mesh mask output 
    128                                                 !: 3 = 3 separate mesh mask output 
    129       INTEGER           :: nn_crs_kz    =    0       !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN)  
    130       LOGICAL           :: ln_crs_wn    = .FALSE.    !: coarsening wn or computation using horizontal divergence  
     124      LOGICAL           :: ln_msh_crs = 1          !: =T Create a meshmask file for CRS 
     125      INTEGER           :: nn_crs_kz    =    0     !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN)  
     126      LOGICAL           :: ln_crs_wn    = .FALSE.  !: coarsening wn or computation using horizontal divergence  
    131127      ! 
    132128      INTEGER           :: nrestx, nresty       !: for determining odd or even reduction factor 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90

    r9125 r9169  
    4848      !! ** Output files :   mesh_hgr_crs.nc, mesh_zgr_crs.nc, mesh_mask.nc 
    4949      !!---------------------------------------------------------------------- 
    50       !! 
    51       INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file 
    52       INTEGER           ::   inum1    ! temprary units for 'mesh.nc'      file 
    53       INTEGER           ::   inum2    ! temprary units for 'mask.nc'      file 
    54       INTEGER           ::   inum3    ! temprary units for 'mesh_hgr.nc'  file 
    55       INTEGER           ::   inum4    ! temprary units for 'mesh_zgr.nc'  file 
     50      INTEGER           ::   ji, jj, jk   ! dummy loop indices 
     51      INTEGER           ::   inum         ! local units for 'mesh_mask.nc' file 
    5652      INTEGER           ::   iif, iil, ijf, ijl 
    57       CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations) 
    58       CHARACTER(len=21) ::   clnam1   ! filename (mesh informations) 
    59       CHARACTER(len=21) ::   clnam2   ! filename (mask informations) 
    60       CHARACTER(len=21) ::   clnam3   ! filename (horizontal mesh informations) 
    61       CHARACTER(len=21) ::   clnam4   ! filename (vertical   mesh informations) 
    62       INTEGER           ::   ji, jj, jk   ! dummy loop indices 
    63       !                                   !  workspaces 
    64       REAL(wp), DIMENSION(jpi_crs,jpj_crs    ) :: zprt, zprw  
    65       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) :: zdepu, zdepv 
    66       REAL(wp), DIMENSION(jpi_crs,jpj_crs    ) :: ze3tp, ze3wp 
    67       !!---------------------------------------------------------------------- 
    68       ! 
    69       ze3tp(:,:) = 0.0 
    70       ze3wp(:,:) = 0.0 
    71  
     53      CHARACTER(len=21) ::   clnam        ! filename (mesh and mask informations) 
     54      !                                   !  workspace 
     55      REAL(wp), DIMENSION(jpi_crs,jpj_crs    ) ::   zprt, zprw  
     56      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk) ::   zdepu, zdepv 
     57      !!---------------------------------------------------------------------- 
     58      ! 
    7259      ! 
    7360      IF(lwp) WRITE(numout,*) 
    74       IF(lwp) WRITE(numout,*) 'crs_dom_wri : create NetCDF mesh and mask information file(s)' 
    75       IF(lwp) WRITE(numout,*) '~~~~~~~' 
    76        
    77       clnam0 = 'mesh_mask_crs'  ! filename (mesh and mask informations) 
    78       clnam1 = 'mesh_crs'       ! filename (mesh informations) 
    79       clnam2 = 'mask_crs'       ! filename (mask informations) 
    80       clnam3 = 'mesh_hgr_crs'   ! filename (horizontal mesh informations) 
    81       clnam4 = 'mesh_zgr_crs'   ! filename (vertical   mesh informations) 
    82        
    83  
    84       SELECT CASE ( MOD(nn_msh_crs, 3) ) 
    85          !                                  ! ============================ 
    86       CASE ( 1 )                            !  create 'mesh_mask.nc' file 
    87          !                                  ! ============================ 
    88          CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 
    89          inum2 = inum0                                            ! put all the informations 
    90          inum3 = inum0                                            ! in unit inum0 
    91          inum4 = inum0 
    92           
    93          !                                  ! ============================ 
    94       CASE ( 2 )                            !  create 'mesh.nc' and  
    95          !                                  !         'mask.nc' files 
    96          !                                  ! ============================ 
    97          CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib ) 
    98          CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 
    99          inum3 = inum1                                            ! put mesh informations  
    100          inum4 = inum1                                            ! in unit inum1  
    101          !                                  ! ============================ 
    102       CASE ( 0 )                            !  create 'mesh_hgr.nc' 
    103          !                                  !         'mesh_zgr.nc' and 
    104          !                                  !         'mask.nc'     files 
    105          !                                  ! ============================ 
    106          CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 
    107          CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib ) 
    108          CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib ) 
    109          ! 
    110       END SELECT 
     61      IF(lwp) WRITE(numout,*) 'crs_dom_wri : create NetCDF mesh and mask file' 
     62      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     63       
     64      clnam = 'mesh_mask_crs'  ! filename (mesh and mask informations) 
     65       
     66 
     67      !                            ! ============================ 
     68      !                            !  create 'mesh_mask.nc' file 
     69      !                            ! ============================ 
     70      ! 
     71      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
    11172  
    112       !======================================================== 
    113       !                                                         ! masks (inum2)  
    114       CALL iom_rstput( 0, 0, inum2, 'tmask', tmask_crs, ktype = jp_i1 )     !    ! land-sea mask 
    115       CALL iom_rstput( 0, 0, inum2, 'umask', umask_crs, ktype = jp_i1 ) 
    116       CALL iom_rstput( 0, 0, inum2, 'vmask', vmask_crs, ktype = jp_i1 ) 
    117       CALL iom_rstput( 0, 0, inum2, 'fmask', fmask_crs, ktype = jp_i1 ) 
     73      CALL iom_rstput( 0, 0, inum, 'tmask', tmask_crs, ktype = jp_i1 )    ! land-sea mask 
     74      CALL iom_rstput( 0, 0, inum, 'umask', umask_crs, ktype = jp_i1 ) 
     75      CALL iom_rstput( 0, 0, inum, 'vmask', vmask_crs, ktype = jp_i1 ) 
     76      CALL iom_rstput( 0, 0, inum, 'fmask', fmask_crs, ktype = jp_i1 ) 
    11877       
    11978       
    … …  
    147106      ENDIF 
    148107       
    149       CALL iom_rstput( 0, 0, inum2, 'tmaskutil', tmask_i_crs, ktype = jp_i1 ) 
     108      CALL iom_rstput( 0, 0, inum, 'tmaskutil', tmask_i_crs, ktype = jp_i1 ) 
    150109                                   !    ! unique point mask 
    151110      CALL dom_uniq_crs( zprw, 'U' ) 
    152111      zprt = umask_crs(:,:,1) * zprw 
    153       CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )   
     112      CALL iom_rstput( 0, 0, inum, 'umaskutil', zprt, ktype = jp_i1 )   
    154113      CALL dom_uniq_crs( zprw, 'V' ) 
    155114      zprt = vmask_crs(:,:,1) * zprw 
    156       CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )   
     115      CALL iom_rstput( 0, 0, inum, 'vmaskutil', zprt, ktype = jp_i1 )   
    157116      CALL dom_uniq_crs( zprw, 'F' ) 
    158117      zprt = fmask_crs(:,:,1) * zprw 
    159       CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )   
     118      CALL iom_rstput( 0, 0, inum, 'fmaskutil', zprt, ktype = jp_i1 )   
    160119      !======================================================== 
    161       !                                                         ! horizontal mesh (inum3) 
    162       CALL iom_rstput( 0, 0, inum3, 'glamt', glamt_crs, ktype = jp_r4 )     !    ! latitude 
    163       CALL iom_rstput( 0, 0, inum3, 'glamu', glamu_crs, ktype = jp_r4 ) 
    164       CALL iom_rstput( 0, 0, inum3, 'glamv', glamv_crs, ktype = jp_r4 ) 
    165       CALL iom_rstput( 0, 0, inum3, 'glamf', glamf_crs, ktype = jp_r4 ) 
    166        
    167       CALL iom_rstput( 0, 0, inum3, 'gphit', gphit_crs, ktype = jp_r4 )     !    ! longitude 
    168       CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu_crs, ktype = jp_r4 ) 
    169       CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv_crs, ktype = jp_r4 ) 
    170       CALL iom_rstput( 0, 0, inum3, 'gphif', gphif_crs, ktype = jp_r4 ) 
    171        
    172       CALL iom_rstput( 0, 0, inum3, 'e1t', e1t_crs, ktype = jp_r8 )         !    ! e1 scale factors 
    173       CALL iom_rstput( 0, 0, inum3, 'e1u', e1u_crs, ktype = jp_r8 ) 
    174       CALL iom_rstput( 0, 0, inum3, 'e1v', e1v_crs, ktype = jp_r8 ) 
    175       CALL iom_rstput( 0, 0, inum3, 'e1f', e1f_crs, ktype = jp_r8 ) 
    176        
    177       CALL iom_rstput( 0, 0, inum3, 'e2t', e2t_crs, ktype = jp_r8 )         !    ! e2 scale factors 
    178       CALL iom_rstput( 0, 0, inum3, 'e2u', e2u_crs, ktype = jp_r8 ) 
    179       CALL iom_rstput( 0, 0, inum3, 'e2v', e2v_crs, ktype = jp_r8 ) 
    180       CALL iom_rstput( 0, 0, inum3, 'e2f', e2f_crs, ktype = jp_r8 ) 
    181        
    182       CALL iom_rstput( 0, 0, inum3, 'ff', ff_crs, ktype = jp_r8 )           !    ! coriolis factor 
     120      !                                                         ! horizontal mesh 
     121      CALL iom_rstput( 0, 0, inum, 'glamt', glamt_crs, ktype = jp_r4 )     !    ! latitude 
     122      CALL iom_rstput( 0, 0, inum, 'glamu', glamu_crs, ktype = jp_r4 ) 
     123      CALL iom_rstput( 0, 0, inum, 'glamv', glamv_crs, ktype = jp_r4 ) 
     124      CALL iom_rstput( 0, 0, inum, 'glamf', glamf_crs, ktype = jp_r4 ) 
     125       
     126      CALL iom_rstput( 0, 0, inum, 'gphit', gphit_crs, ktype = jp_r4 )     !    ! longitude 
     127      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu_crs, ktype = jp_r4 ) 
     128      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv_crs, ktype = jp_r4 ) 
     129      CALL iom_rstput( 0, 0, inum, 'gphif', gphif_crs, ktype = jp_r4 ) 
     130       
     131      CALL iom_rstput( 0, 0, inum, 'e1t', e1t_crs, ktype = jp_r8 )         !    ! e1 scale factors 
     132      CALL iom_rstput( 0, 0, inum, 'e1u', e1u_crs, ktype = jp_r8 ) 
     133      CALL iom_rstput( 0, 0, inum, 'e1v', e1v_crs, ktype = jp_r8 ) 
     134      CALL iom_rstput( 0, 0, inum, 'e1f', e1f_crs, ktype = jp_r8 ) 
     135       
     136      CALL iom_rstput( 0, 0, inum, 'e2t', e2t_crs, ktype = jp_r8 )         !    ! e2 scale factors 
     137      CALL iom_rstput( 0, 0, inum, 'e2u', e2u_crs, ktype = jp_r8 ) 
     138      CALL iom_rstput( 0, 0, inum, 'e2v', e2v_crs, ktype = jp_r8 ) 
     139      CALL iom_rstput( 0, 0, inum, 'e2f', e2f_crs, ktype = jp_r8 ) 
     140       
     141      CALL iom_rstput( 0, 0, inum, 'ff', ff_crs, ktype = jp_r8 )           !    ! coriolis factor 
    183142 
    184143      !======================================================== 
    185       !                                                         ! vertical mesh (inum4)  
     144      !                                                         ! vertical mesh 
    186145!     ! note that mbkt is set to 1 over land ==> use surface tmask_crs 
    187146      zprt(:,:) = tmask_crs(:,:,1) * REAL( mbkt_crs(:,:) , wp ) 
    188       CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 )     !    ! nb of ocean T-points 
    189  
    190       IF( ln_zps ) THEN                       ! z-coordinate - partial steps 
    191  
    192              
    193          IF ( nn_msh_crs <= 6 ) THEN 
    194             CALL iom_rstput( 0, 0, inum4, 'e3t', e3t_crs )       
    195             CALL iom_rstput( 0, 0, inum4, 'e3w', e3w_crs )       
    196             CALL iom_rstput( 0, 0, inum4, 'e3u', e3u_crs )       
    197             CALL iom_rstput( 0, 0, inum4, 'e3v', e3v_crs )       
    198          ELSE 
    199             DO jj = 1,jpj_crs    
    200                DO ji = 1,jpi_crs 
    201                   ze3tp(ji,jj) = e3t_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1) 
    202                   ze3wp(ji,jj) = e3w_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1) 
    203                END DO 
    204             END DO 
    205  
    206             CALL crs_lbc_lnk( ze3tp,'T', 1.0 ) 
    207             CALL crs_lbc_lnk( ze3wp,'W', 1.0 ) 
    208    
    209             CALL iom_rstput( 0, 0, inum4, 'e3t_ps', ze3tp )       
    210             CALL iom_rstput( 0, 0, inum4, 'e3w_ps', ze3wp ) 
    211          ENDIF 
    212  
    213          IF ( nn_msh_crs <= 3 ) THEN 
    214             CALL iom_rstput( 0, 0, inum4, 'gdept', gdept_crs, ktype = jp_r4 )  
    215             DO jk = 1,jpk    
    216                DO jj = 1, jpj_crsm1    
    217                   DO ji = 1, jpi_crsm1  ! jes what to do for fs_jpim1??vector opt. 
    218                      zdepu(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji+1,jj  ,jk) ) * umask_crs(ji,jj,jk) 
    219                      zdepv(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji  ,jj+1,jk) ) * vmask_crs(ji,jj,jk) 
    220                   END DO    
    221                END DO    
    222             END DO 
    223  
    224             CALL crs_lbc_lnk( zdepu,'U', 1. )   ;   CALL crs_lbc_lnk( zdepv,'V', 1. )  
    225             CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r4 ) 
    226             CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r4 ) 
    227             CALL iom_rstput( 0, 0, inum4, 'gdepw', gdepw_crs, ktype = jp_r4 ) 
    228          ELSE 
    229             DO jj = 1,jpj_crs    
    230                DO ji = 1,jpi_crs 
    231                   zprt(ji,jj) = gdept_0(ji,jj,mbkt(ji,jj)  ) * tmask(ji,jj,1) 
    232                   zprw(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) * tmask(ji,jj,1) 
    233                END DO 
    234             END DO 
    235             CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r4 )      
    236             CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r4 )  
    237          ENDIF 
    238  
    239          CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )     !    ! reference z-coord. 
    240          CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d ) 
    241          CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   ) 
    242          CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   ) 
    243  
    244          CALL iom_rstput(  0, 0, inum4, 'ocean_volume_t', ocean_volume_crs_t )  
    245          CALL iom_rstput(  0, 0, inum4, 'facvol_t' , facvol_t  )  
    246          CALL iom_rstput(  0, 0, inum4, 'facvol_w' , facvol_w  )  
    247          CALL iom_rstput(  0, 0, inum4, 'facsurfu' , facsurfu  )  
    248          CALL iom_rstput(  0, 0, inum4, 'facsurfv' , facsurfv  )  
    249          CALL iom_rstput(  0, 0, inum4, 'e1e2w_msk', e1e2w_msk )  
    250          CALL iom_rstput(  0, 0, inum4, 'e2e3u_msk', e2e3u_msk )  
    251          CALL iom_rstput(  0, 0, inum4, 'e1e3v_msk', e1e3v_msk ) 
    252          CALL iom_rstput(  0, 0, inum4, 'e1e2w'    , e1e2w_crs )  
    253          CALL iom_rstput(  0, 0, inum4, 'e2e3u'    , e2e3u_crs )  
    254          CALL iom_rstput(  0, 0, inum4, 'e1e3v'    , e1e3v_crs ) 
    255          CALL iom_rstput(  0, 0, inum4, 'bt'       , bt_crs    ) 
    256          CALL iom_rstput(  0, 0, inum4, 'r1_bt'    , r1_bt_crs ) 
    257  
    258          CALL iom_rstput(  0, 0, inum4, 'crs_surfu_wgt', crs_surfu_wgt )  
    259          CALL iom_rstput(  0, 0, inum4, 'crs_surfv_wgt', crs_surfv_wgt )  
    260          CALL iom_rstput(  0, 0, inum4, 'crs_volt_wgt' , crs_volt_wgt  )  
    261  
    262       ENDIF 
    263        
    264      IF( ln_zco ) THEN 
    265          !                                                      ! z-coordinate - full steps 
    266         CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )     !    ! depth 
    267         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d ) 
    268         CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )     !    ! scale factors 
    269         CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   ) 
    270      ENDIF 
     147      CALL iom_rstput( 0, 0, inum, 'mbathy', zprt, ktype = jp_i2 )     !    ! nb of ocean T-points 
     148      ! 
     149      CALL iom_rstput( 0, 0, inum, 'e3t', e3t_crs )       
     150      CALL iom_rstput( 0, 0, inum, 'e3w', e3w_crs )       
     151      CALL iom_rstput( 0, 0, inum, 'e3u', e3u_crs )       
     152      CALL iom_rstput( 0, 0, inum, 'e3v', e3v_crs )       
     153      ! 
     154      CALL iom_rstput( 0, 0, inum, 'gdept', gdept_crs, ktype = jp_r4 )  
     155      DO jk = 1,jpk    
     156         DO jj = 1, jpj_crsm1    
     157            DO ji = 1, jpi_crsm1  ! jes what to do for fs_jpim1??vector opt. 
     158               zdepu(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji+1,jj  ,jk) ) * umask_crs(ji,jj,jk) 
     159               zdepv(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji  ,jj+1,jk) ) * vmask_crs(ji,jj,jk) 
     160            END DO    
     161         END DO    
     162      END DO 
     163      CALL crs_lbc_lnk( zdepu,'U', 1. )   ;   CALL crs_lbc_lnk( zdepv,'V', 1. )  
     164      ! 
     165      CALL iom_rstput( 0, 0, inum, 'gdepu', zdepu, ktype = jp_r4 ) 
     166      CALL iom_rstput( 0, 0, inum, 'gdepv', zdepv, ktype = jp_r4 ) 
     167      CALL iom_rstput( 0, 0, inum, 'gdepw', gdepw_crs, ktype = jp_r4 ) 
     168      ! 
     169      CALL iom_rstput( 0, 0, inum, 'gdept_1d', gdept_1d )     !    ! reference z-coord. 
     170      CALL iom_rstput( 0, 0, inum, 'gdepw_1d', gdepw_1d ) 
     171      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d   ) 
     172      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d   ) 
     173      ! 
     174      CALL iom_rstput(  0, 0, inum, 'ocean_volume_t', ocean_volume_crs_t )  
     175      CALL iom_rstput(  0, 0, inum, 'facvol_t' , facvol_t  )  
     176      CALL iom_rstput(  0, 0, inum, 'facvol_w' , facvol_w  )  
     177      CALL iom_rstput(  0, 0, inum, 'facsurfu' , facsurfu  )  
     178      CALL iom_rstput(  0, 0, inum, 'facsurfv' , facsurfv  )  
     179      CALL iom_rstput(  0, 0, inum, 'e1e2w_msk', e1e2w_msk )  
     180      CALL iom_rstput(  0, 0, inum, 'e2e3u_msk', e2e3u_msk )  
     181      CALL iom_rstput(  0, 0, inum, 'e1e3v_msk', e1e3v_msk ) 
     182      CALL iom_rstput(  0, 0, inum, 'e1e2w'    , e1e2w_crs )  
     183      CALL iom_rstput(  0, 0, inum, 'e2e3u'    , e2e3u_crs )  
     184      CALL iom_rstput(  0, 0, inum, 'e1e3v'    , e1e3v_crs ) 
     185      CALL iom_rstput(  0, 0, inum, 'bt'       , bt_crs    ) 
     186      CALL iom_rstput(  0, 0, inum, 'r1_bt'    , r1_bt_crs ) 
     187      ! 
     188      CALL iom_rstput(  0, 0, inum, 'crs_surfu_wgt', crs_surfu_wgt )  
     189      CALL iom_rstput(  0, 0, inum, 'crs_surfv_wgt', crs_surfv_wgt )  
     190      CALL iom_rstput(  0, 0, inum, 'crs_volt_wgt' , crs_volt_wgt  )  
    271191      !                                     ! ============================ 
    272192      !                                     !        close the files  
    273193      !                                     ! ============================ 
    274       SELECT CASE ( MOD(nn_msh_crs, 3) ) 
    275       CASE ( 1 )                 
    276          CALL iom_close( inum0 ) 
    277       CASE ( 2 ) 
    278          CALL iom_close( inum1 ) 
    279          CALL iom_close( inum2 ) 
    280       CASE ( 0 ) 
    281          CALL iom_close( inum2 ) 
    282          CALL iom_close( inum3 ) 
    283          CALL iom_close( inum4 ) 
    284       END SELECT 
     194      CALL iom_close( inum ) 
    285195      ! 
    286196   END SUBROUTINE crs_dom_wri 
    … …  
    296206      !!                2) check which elements have been changed 
    297207      !!---------------------------------------------------------------------- 
    298       ! 
    299208      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
    300209      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r9168 r9169  
    7373      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, ze3w 
    7474 
    75       NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn 
     75      NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, ln_msh_crs, nn_crs_kz, ln_crs_wn 
    7676      !!---------------------------------------------------------------------- 
    7777      ! 
    … …  
    9696        WRITE(numout,*) '      coarsening factor in j-direction      nn_facty   = ', nn_facty 
    9797        WRITE(numout,*) '      bin centering preference              nn_binref  = ', nn_binref 
    98         WRITE(numout,*) '      create (=1) a mesh file or not (=0)   nn_msh_crs = ', nn_msh_crs 
     98        WRITE(numout,*) '      create a mesh file (=T)               ln_msh_crs = ', ln_msh_crs 
    9999        WRITE(numout,*) '      type of Kz coarsening (0,1,2)         nn_crs_kz  = ', nn_crs_kz 
    100100        WRITE(numout,*) '      wn coarsened or computed using hdivn  ln_crs_wn  = ', ln_crs_wn 
    … …  
    228228     !--------------------------------------------------------- 
    229229 
    230      IF( nn_msh_crs > 0 ) THEN  
     230     IF( ln_msh_crs ) THEN  
    231231        CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    232232        CALL crs_dom_wri      

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r9168 r9169  
    231231 
    232232   SUBROUTINE dia_hsb_rst( kt, cdrw ) 
    233      !!--------------------------------------------------------------------- 
    234      !!                   ***  ROUTINE dia_hsb_rst  *** 
    235      !!                      
    236      !! ** Purpose :   Read or write DIA file in restart file 
    237      !! 
    238      !! ** Method  :   use of IOM library 
    239      !!---------------------------------------------------------------------- 
    240      INTEGER         , INTENT(in) ::   kt     ! ocean time-step 
    241      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    242      ! 
    243      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    244      !!---------------------------------------------------------------------- 
    245      ! 
    246      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
    247         IF( ln_rstart ) THEN                   !* Read the restart file 
    248            ! 
    249            IF(lwp) WRITE(numout,*) '~~~~~~~' 
    250            IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 
    251            IF(lwp) WRITE(numout,*) '~~~~~~~' 
    252            CALL iom_get( numror, 'frc_v', frc_v ) 
    253            CALL iom_get( numror, 'frc_t', frc_t ) 
    254            CALL iom_get( numror, 'frc_s', frc_s ) 
    255            IF( ln_linssh ) THEN 
    256               CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 
    257               CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 
    258            ENDIF 
    259            CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 
    260            CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) ) 
    261            CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) ) 
    262            CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 
    263            CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 
    264            IF( ln_linssh ) THEN 
    265               CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 
    266               CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 
    267            ENDIF 
    268        ELSE 
    269           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    270           IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 
    271           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    272           surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface 
    273           ssh_ini(:,:) = sshn(:,:)                          ! initial ssh 
    274           DO jk = 1, jpk 
    275              ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
    276              e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors 
    277              hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content 
    278              sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content 
    279           END DO 
    280           frc_v = 0._wp                                           ! volume       trend due to forcing 
    281           frc_t = 0._wp                                           ! heat content   -    -   -    -    
    282           frc_s = 0._wp                                           ! salt content   -    -   -    -         
    283           IF( ln_linssh ) THEN 
    284              IF ( ln_isfcav ) THEN 
    285                 DO ji=1,jpi 
    286                    DO jj=1,jpj 
    287                       ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj)   ! initial heat content in ssh 
    288                       ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj)   ! initial salt content in ssh 
    289                    ENDDO 
    290                 ENDDO 
    291              ELSE 
    292                 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh 
    293                 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh 
    294              END IF 
    295              frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface 
    296              frc_wn_s = 0._wp                                       ! initial salt content misfit due to free surface 
    297           ENDIF 
    298        ENDIF 
    299  
    300      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
    301         !                                   ! ------------------- 
    302         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    303         IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 
    304         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    305  
    306         CALL iom_rstput( kt, nitrst, numrow, 'frc_v'   , frc_v     ) 
    307         CALL iom_rstput( kt, nitrst, numrow, 'frc_t'   , frc_t     ) 
    308         CALL iom_rstput( kt, nitrst, numrow, 'frc_s'   , frc_s     ) 
    309         IF( ln_linssh ) THEN 
    310            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 
    311            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 
    312         ENDIF 
    313         CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini )      ! ice sheet coupling 
    314         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:) ) 
    315         CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:) ) 
    316         CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 
    317         CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 
    318         IF( ln_linssh ) THEN 
    319            CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 
    320            CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 
    321         ENDIF 
    322         ! 
    323      ENDIF 
    324      ! 
     233      !!--------------------------------------------------------------------- 
     234      !!                   ***  ROUTINE dia_hsb_rst  *** 
     235      !!                      
     236      !! ** Purpose :   Read or write DIA file in restart file 
     237      !! 
     238      !! ** Method  :   use of IOM library 
     239      !!---------------------------------------------------------------------- 
     240      INTEGER         , INTENT(in) ::   kt     ! ocean time-step 
     241      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
     242      ! 
     243      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     244      !!---------------------------------------------------------------------- 
     245      ! 
     246      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
     247         IF( ln_rstart ) THEN                   !* Read the restart file 
     248            ! 
     249            IF(lwp) WRITE(numout,*) 
     250            IF(lwp) WRITE(numout,*) '   dia_hsb_rst : read hsb restart at it= ', kt,' date= ', ndastp 
     251            IF(lwp) WRITE(numout,*) 
     252            CALL iom_get( numror, 'frc_v', frc_v ) 
     253            CALL iom_get( numror, 'frc_t', frc_t ) 
     254            CALL iom_get( numror, 'frc_s', frc_s ) 
     255            IF( ln_linssh ) THEN 
     256               CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 
     257               CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 
     258            ENDIF 
     259            CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 
     260            CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) ) 
     261            CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) ) 
     262            CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 
     263            CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 
     264            IF( ln_linssh ) THEN 
     265               CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 
     266               CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 
     267            ENDIF 
     268          ELSE 
     269            IF(lwp) WRITE(numout,*) 
     270            IF(lwp) WRITE(numout,*) '   dia_hsb_rst : initialise hsb at initial state ' 
     271            IF(lwp) WRITE(numout,*) 
     272            surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface 
     273            ssh_ini(:,:) = sshn(:,:)                          ! initial ssh 
     274            DO jk = 1, jpk 
     275              ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
     276               e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors 
     277               hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content 
     278               sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content 
     279            END DO 
     280            frc_v = 0._wp                                           ! volume       trend due to forcing 
     281            frc_t = 0._wp                                           ! heat content   -    -   -    -    
     282            frc_s = 0._wp                                           ! salt content   -    -   -    -         
     283            IF( ln_linssh ) THEN 
     284               IF( ln_isfcav ) THEN 
     285                  DO ji = 1, jpi 
     286                     DO jj = 1, jpj 
     287                        ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj)   ! initial heat content in ssh 
     288                        ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj)   ! initial salt content in ssh 
     289                     END DO 
     290                   END DO 
     291                ELSE 
     292                  ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh 
     293                  ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh 
     294               END IF 
     295               frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface 
     296               frc_wn_s = 0._wp                                       ! initial salt content misfit due to free surface 
     297            ENDIF 
     298         ENDIF 
     299         ! 
     300      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
     301         !                                   ! ------------------- 
     302         IF(lwp) WRITE(numout,*) 
     303         IF(lwp) WRITE(numout,*) '   dia_hsb_rst : write restart at it= ', kt,' date= ', ndastp 
     304         IF(lwp) WRITE(numout,*) 
     305         ! 
     306         CALL iom_rstput( kt, nitrst, numrow, 'frc_v'   , frc_v     ) 
     307         CALL iom_rstput( kt, nitrst, numrow, 'frc_t'   , frc_t     ) 
     308         CALL iom_rstput( kt, nitrst, numrow, 'frc_s'   , frc_s     ) 
     309         IF( ln_linssh ) THEN 
     310            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 
     311            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 
     312         ENDIF 
     313         CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini )      ! ice sheet coupling 
     314         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:) ) 
     315         CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:) ) 
     316         CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 
     317         CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 
     318         IF( ln_linssh ) THEN 
     319            CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 
     320            CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 
     321         ENDIF 
     322         ! 
     323      ENDIF 
     324      ! 
    325325   END SUBROUTINE dia_hsb_rst 
    326326 
    … …  
    338338      !!             - Compute coefficients for conversion 
    339339      !!--------------------------------------------------------------------------- 
    340       INTEGER ::   ierror   ! local integer 
    341       INTEGER ::   ios 
     340      INTEGER ::   ierror, ios   ! local integer 
    342341      !! 
    343342      NAMELIST/namhsb/ ln_diahsb 
    344343      !!---------------------------------------------------------------------- 
    345344      ! 
     345      IF(lwp) THEN 
     346         WRITE(numout,*) 
     347         WRITE(numout,*) 'dia_hsb_init : heat and salt budgets diagnostics' 
     348         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     349      ENDIF 
    346350      REWIND( numnam_ref )              ! Namelist namhsb in reference namelist 
    347351      READ  ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) 
    … …  
    350354      READ  ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 
    351355902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 
    352       IF(lwm) WRITE ( numond, namhsb ) 
     356      IF(lwm) WRITE( numond, namhsb ) 
    353357 
    354358      IF(lwp) THEN 
    355          WRITE(numout,*) 
    356          WRITE(numout,*) 'dia_hsb_init : heat and salt budgets diagnostics' 
    357          WRITE(numout,*) '~~~~~~~~~~~~ ' 
    358359         WRITE(numout,*) '   Namelist  namhsb :' 
    359360         WRITE(numout,*) '      check the heat and salt budgets (T) or not (F)       ln_diahsb = ', ln_diahsb 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

    r9161 r9169  
    123123         ENDIF 
    124124      ELSE  
    125          IF( lwp ) WRITE(numout,*) 'closea_mask field not found in domain_cfg file. No closed seas defined.' 
     125         IF( lwp ) WRITE(numout,*) 
     126         IF( lwp ) WRITE(numout,*) '   ==>>>   closea_mask field not found in domain_cfg file.' 
     127         IF( lwp ) WRITE(numout,*) '           No closed seas defined.' 
     128         IF( lwp ) WRITE(numout,*) 
    126129         l_sbc_clo = .false. 
    127130         jncs = 0  

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r9161 r9169  
    3131   !                                   !!* Namelist namdom : time & space domain * 
    3232   LOGICAL , PUBLIC ::   ln_linssh      !: =T  linear free surface ==>> model level are fixed in time 
    33    INTEGER , PUBLIC ::   nn_msh         !: >0  create a mesh-mask file (mesh_mask.nc) 
     33   LOGICAL , PUBLIC ::   ln_meshmask    !: =T  create a mesh-mask file (mesh_mask.nc) 
    3434   REAL(wp), PUBLIC ::   rn_isfhmin     !: threshold to discriminate grounded ice to floating ice 
    3535   REAL(wp), PUBLIC ::   rn_rdt         !: time step for the dynamics and tracer 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r9168 r9169  
    7070      !!                         and scale factors, and the coriolis factor 
    7171      !!              - dom_zgr: define the vertical coordinate and the bathymetry 
    72       !!              - dom_wri: create the meshmask file if nn_msh=1 
     72      !!              - dom_wri: create the meshmask file (ln_meshmask=T) 
    7373      !!              - 1D configuration, move Coriolis, u and v at T-point 
    7474      !!---------------------------------------------------------------------- 
    … …  
    110110         END SELECT 
    111111         WRITE(numout,*)     '      Ocean model configuration used:' 
    112          WRITE(numout,*)     '              cn_cfg = ', cn_cfg 
    113          WRITE(numout,*)     '              nn_cfg = ', nn_cfg 
     112         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg 
    114113      ENDIF 
    115114      ! 
    … …  
    176175      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point 
    177176      ! 
    178       IF( nn_msh > 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file 
    179       IF( nn_msh > 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file 
    180       IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control 
    181       ! 
    182        
     177      IF( ln_meshmask .AND. .NOT.ln_iscpl )                        CALL dom_wri     ! Create a domain file 
     178      IF( ln_meshmask .AND.      ln_iscpl .AND. .NOT.ln_rstart )   CALL dom_wri     ! Create a domain file 
     179      IF(                                       .NOT.ln_rstart )   CALL dom_ctl     ! Domain control 
     180      ! 
     181      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file 
     182      ! 
    183183      IF(lwp) THEN 
    184184         WRITE(numout,*) 
    185          WRITE(numout,*) 'dom_init : end of domain initialization nn_msh=', nn_msh 
     185         WRITE(numout,*) 'dom_init :   ==>>>   END of domain initialization' 
     186         WRITE(numout,*) '~~~~~~~~' 
    186187         WRITE(numout,*)  
    187188      ENDIF 
    188       ! 
    189       IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file 
    190189      ! 
    191190   END SUBROUTINE dom_init 
    … …  
    269268      !!---------------------------------------------------------------------- 
    270269      USE ioipsl 
     270      !! 
     271      INTEGER  ::   ios   ! Local integer 
     272      ! 
    271273      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 & 
    272274         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     & 
    … …  
    274276         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     & 
    275277         &             ln_cfmeta, ln_iscpl 
    276       NAMELIST/namdom/ ln_linssh, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs 
     278      NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask 
    277279#if defined key_netcdf4 
    278280      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 
    279281#endif 
    280       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    281       !!---------------------------------------------------------------------- 
     282      !!---------------------------------------------------------------------- 
     283      ! 
     284      IF(lwp) THEN 
     285         WRITE(numout,*) 
     286         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read' 
     287         WRITE(numout,*) '~~~~~~~ ' 
     288      ENDIF 
    282289      ! 
    283290      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run 
    … …  
    290297      ! 
    291298      IF(lwp) THEN                  ! control print 
    292          WRITE(numout,*) 
    293          WRITE(numout,*) 'dom_nam  : domain initialization through namelist read' 
    294          WRITE(numout,*) '~~~~~~~ ' 
    295          WRITE(numout,*) '   Namelist namrun' 
    296          WRITE(numout,*) '      job number                      nn_no      = ', nn_no 
    297          WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp 
    298          WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in 
    299          WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir 
    300          WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out 
    301          WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir 
    302          WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart 
    303          WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler 
    304          WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl 
    305          WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000 
    306          WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend 
    307          WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0 
    308          WRITE(numout,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0 
    309          WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy 
    310          WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate 
     299         WRITE(numout,*) '   Namelist : namrun' 
     300         WRITE(numout,*) '      job number                      nn_no           = ', nn_no 
     301         WRITE(numout,*) '      experiment name for output      cn_exp          = ', TRIM( cn_exp           ) 
     302         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in    = ', TRIM( cn_ocerst_in     ) 
     303         WRITE(numout,*) '      restart input directory         cn_ocerst_indir = ', TRIM( cn_ocerst_indir  ) 
     304         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out   = ', TRIM( cn_ocerst_out    ) 
     305         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir ) 
     306         WRITE(numout,*) '      restart logical                 ln_rstart       = ', ln_rstart 
     307         WRITE(numout,*) '      start with forward time step    nn_euler        = ', nn_euler 
     308         WRITE(numout,*) '      control of time step            nn_rstctl       = ', nn_rstctl 
     309         WRITE(numout,*) '      number of the first time step   nn_it000        = ', nn_it000 
     310         WRITE(numout,*) '      number of the last time step    nn_itend        = ', nn_itend 
     311         WRITE(numout,*) '      initial calendar date aammjj    nn_date0        = ', nn_date0 
     312         WRITE(numout,*) '      initial time of day in hhmm     nn_time0        = ', nn_time0 
     313         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy        = ', nn_leapy 
     314         WRITE(numout,*) '      initial state output            nn_istate       = ', nn_istate 
    311315         IF( ln_rst_list ) THEN 
    312             WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist 
     316            WRITE(numout,*) '      list of restart dump times      nn_stocklist    =', nn_stocklist 
    313317         ELSE 
    314             WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock 
     318            WRITE(numout,*) '      frequency of restart file       nn_stock        = ', nn_stock 
    315319         ENDIF 
    316          WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write 
    317          WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland 
    318          WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta 
    319          WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber 
    320          WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz 
    321          WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl 
     320         WRITE(numout,*) '      frequency of output file        nn_write        = ', nn_write 
     321         WRITE(numout,*) '      mask land points                ln_mskland      = ', ln_mskland 
     322         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta       = ', ln_cfmeta 
     323         WRITE(numout,*) '      overwrite an existing file      ln_clobber      = ', ln_clobber 
     324         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz      = ', nn_chunksz 
     325         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl        = ', ln_iscpl 
    322326      ENDIF 
    323327 
    … …  
    336340      IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN 
    337341         IF(lwp) WRITE(numout,*)   
    338          IF(lwp) WRITE(numout,*)'   Start from rest (ln_rstart=F) ==>>> an Euler initial time step is used,' 
    339          IF(lwp) WRITE(numout,*)'                                       nn_euler is forced to 0 '    
     342         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)' 
     343         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : nn_euler is forced to 0 '    
    340344         neuler = 0 
    341345      ENDIF 
    342346      !                             ! control of output frequency 
    343       IF ( nstock == 0 .OR. nstock > nitend ) THEN 
     347      IF( nstock == 0 .OR. nstock > nitend ) THEN 
    344348         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend 
    345349         CALL ctl_warn( ctmp1 ) 
    … …  
    376380      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 
    377381904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
    378       IF(lwm) WRITE ( numond, namdom ) 
     382      IF(lwm) WRITE( numond, namdom ) 
    379383      ! 
    380384      IF(lwp) THEN 
    381385         WRITE(numout,*) 
    382          WRITE(numout,*) '   Namelist namdom : space & time domain' 
    383          WRITE(numout,*) '      linear free surface (=T)              ln_linssh  = ', ln_linssh 
    384          WRITE(numout,*) '      create mesh/mask file(s)              nn_msh     = ', nn_msh 
    385          WRITE(numout,*) '           = 0   no file created           ' 
    386          WRITE(numout,*) '           = 1   mesh_mask                 ' 
    387          WRITE(numout,*) '           = 2   mesh and mask             ' 
    388          WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask' 
    389          WRITE(numout,*) '      treshold to open the isf cavity       rn_isfhmin = ', rn_isfhmin, ' (m)' 
    390          WRITE(numout,*) '      ocean time step                       rn_rdt     = ', rn_rdt 
    391          WRITE(numout,*) '      asselin time filter parameter         rn_atfp    = ', rn_atfp 
    392          WRITE(numout,*) '      online coarsening of dynamical fields ln_crs     = ', ln_crs 
    393       ENDIF 
    394        
    395       call flush( numout ) 
    396       ! 
    397 !     !          ! conversion DOCTOR names into model names (this should disappear soon) 
    398       atfp      = rn_atfp 
    399       rdt       = rn_rdt 
     386         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain' 
     387         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh 
     388         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask 
     389         WRITE(numout,*) '      treshold to open the isf cavity         rn_isfhmin  = ', rn_isfhmin, ' [m]' 
     390         WRITE(numout,*) '      ocean time step                         rn_rdt      = ', rn_rdt 
     391         WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp 
     392         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs 
     393      ENDIF 
     394      ! 
     395      !          ! conversion DOCTOR names into model names (this should disappear soon) 
     396      atfp = rn_atfp 
     397      rdt  = rn_rdt 
    400398 
    401399#if defined key_netcdf4 
    … …  
    403401      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF 
    404402      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 
    405 907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 
     403907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 
    406404      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF 
    407405      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) 
    408 908   IF( ios >  0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp ) 
     406908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp ) 
    409407      IF(lwm) WRITE( numond, namnc4 ) 
    410408 
    … …  
    412410         WRITE(numout,*) 
    413411         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters' 
    414          WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i  = ', nn_nchunks_i 
    415          WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j  = ', nn_nchunks_j 
    416          WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k  = ', nn_nchunks_k 
    417          WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip 
     412         WRITE(numout,*) '      number of chunks in i-dimension             nn_nchunks_i = ', nn_nchunks_i 
     413         WRITE(numout,*) '      number of chunks in j-dimension             nn_nchunks_j = ', nn_nchunks_j 
     414         WRITE(numout,*) '      number of chunks in k-dimension             nn_nchunks_k = ', nn_nchunks_k 
     415         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression   ln_nc4zip    = ', ln_nc4zip 
    418416      ENDIF 
    419417 
    … …  
    487485      !! ** Purpose :   read the domain size in domain configuration file 
    488486      !! 
    489       !! ** Method  :    
    490       !! 
     487      !! ** Method  :   read the cn_domcfg NetCDF file 
    491488      !!---------------------------------------------------------------------- 
    492489      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information 
    … …  
    503500      ii = 1 
    504501      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1 
    505       WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'   ;   ii = ii+1 
     502      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'  ;   ii = ii+1 
    506503      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1 
    507504      ! 
    … …  
    515512         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = INT( zorca_res ) 
    516513         ! 
    517          WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1 
    518          WRITE(ldtxt(ii),*) '       ==>>>   ORCA configuration '                         ;   ii = ii+1 
    519          WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1 
     514         WRITE(ldtxt(ii),*) '       '                                                     ;   ii = ii+1 
     515         WRITE(ldtxt(ii),*) '       ==>>>   ORCA configuration '                          ;   ii = ii+1 
     516         WRITE(ldtxt(ii),*) '       '                                                     ;   ii = ii+1 
    520517         ! 
    521518      ELSE                                !- cd_cfg & k_cfg are not used 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r9019 r9169  
    9191      IF( ln_read_cfg ) THEN        !==  read in mesh_mask.nc file  ==! 
    9292         IF(lwp) WRITE(numout,*) 
    93          IF(lwp) WRITE(numout,*) '          read horizontal mesh in ', TRIM( cn_domcfg ), ' file' 
     93         IF(lwp) WRITE(numout,*) '   ==>>>   read horizontal mesh in ', TRIM( cn_domcfg ), ' file' 
    9494         ! 
    9595         CALL hgr_read   ( glamt , glamu , glamv , glamf ,   &    ! geographic position (required) 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r9168 r9169  
    119119         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat  
    120120      ENDIF 
    121  
    122       IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  free-slip ' 
    123       ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  no-slip ' 
    124       ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  partial-slip ' 
    125       ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  strong-slip ' 
     121      ! 
     122      IF(lwp) WRITE(numout,*) 
     123      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  free-slip' 
     124      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  no-slip' 
     125      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  partial-slip' 
     126      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  strong-slip' 
    126127      ELSE 
    127128         WRITE(ctmp1,*) ' rn_shlat is negative = ', rn_shlat 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r9124 r9169  
    4949      !!      diagnostic computation. 
    5050      !! 
    51       !! ** Method  :   Write in a file all the arrays generated in routines 
    52       !!      domhgr, domzgr, and dommsk. Note: the file contain depends on 
    53       !!      the vertical coord. used (z-coord, partial steps, s-coord) 
    54       !!            MOD(nn_msh, 3) = 1  :   'mesh_mask.nc' file 
    55       !!                         = 2  :   'mesh.nc' and mask.nc' files 
    56       !!                         = 0  :   'mesh_hgr.nc', 'mesh_zgr.nc' and 
    57       !!                                  'mask.nc' files 
    58       !!      For huge size domain, use option 2 or 3 depending on your  
    59       !!      vertical coordinate. 
    60       !! 
    61       !!      if     nn_msh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw] 
    62       !!      if 3 < nn_msh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays  
    63       !!                        corresponding to the depth of the bottom t- and w-points 
    64       !!      if 6 < nn_msh <= 9: write 2D arrays corresponding to the depth and the 
    65       !!                        thickness (e3[tw]_ps) of the bottom points  
     51      !! ** Method  :   create a file with all domain related arrays 
    6652      !! 
    6753      !! ** output file :   meshmask.nc  : domain size, horizontal grid-point position, 
    … …  
    196182      CALL iom_close( inum )                !        close the files  
    197183      !                                     ! ============================ 
    198       ! 
    199184   END SUBROUTINE dom_wri 
    200185 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r9161 r9169  
    8787      IF( ln_read_cfg ) THEN        !==  read in mesh_mask.nc file  ==! 
    8888         IF(lwp) WRITE(numout,*) 
    89          IF(lwp) WRITE(numout,*) '          Read vertical mesh in ', TRIM( cn_domcfg ), ' file' 
     89         IF(lwp) WRITE(numout,*) '   ==>>>   Read vertical mesh in ', TRIM( cn_domcfg ), ' file' 
    9090         ! 
    9191         CALL zgr_read   ( ln_zco  , ln_zps  , ln_sco, ln_isfcav,   &  

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90

    r9090 r9169  
    7777          
    7878      !                       ! create  a domain file 
    79       IF( nn_msh /= 0 .AND. ln_iscpl )   CALL dom_wri 
     79      IF( ln_meshmask .AND. ln_iscpl )   CALL dom_wri 
    8080      ! 
    8181      IF ( ln_hsb ) THEN 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r9019 r9169  
    113113      ! ------------------------ 
    114114      IF(lwp) WRITE(numout,*) 
    115       IF(lwp) WRITE(numout,*) '       Constants' 
     115      IF(lwp) WRITE(numout,*) '   Constants' 
    116116 
    117117      IF(lwp) WRITE(numout,*) 
    118       IF(lwp) WRITE(numout,*) '          mathematical constant                 rpi = ', rpi 
     118      IF(lwp) WRITE(numout,*) '      mathematical constant                 rpi = ', rpi 
    119119 
    120120      rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp 
    … …  
    126126#endif 
    127127      IF(lwp) WRITE(numout,*) 
    128       IF(lwp) WRITE(numout,*) '          day                                rday   = ', rday,   ' s' 
    129       IF(lwp) WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s' 
    130       IF(lwp) WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s' 
    131       IF(lwp) WRITE(numout,*) '          omega                              omega  = ', omega,  ' s^-1' 
    132  
     128      IF(lwp) WRITE(numout,*) '      day                                rday   = ', rday,   ' s' 
     129      IF(lwp) WRITE(numout,*) '      sideral year                       rsiyea = ', rsiyea, ' s' 
     130      IF(lwp) WRITE(numout,*) '      sideral day                        rsiday = ', rsiday, ' s' 
     131      IF(lwp) WRITE(numout,*) '      omega                              omega  = ', omega,  ' s^-1' 
    133132      IF(lwp) WRITE(numout,*) 
    134       IF(lwp) WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months' 
    135       IF(lwp) WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours' 
    136       IF(lwp) WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn' 
    137       IF(lwp) WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s' 
    138  
     133      IF(lwp) WRITE(numout,*) '      nb of months per year               raamo = ', raamo, ' months' 
     134      IF(lwp) WRITE(numout,*) '      nb of hours per day                 rjjhh = ', rjjhh, ' hours' 
     135      IF(lwp) WRITE(numout,*) '      nb of minutes per hour              rhhmm = ', rhhmm, ' mn' 
     136      IF(lwp) WRITE(numout,*) '      nb of seconds per minute            rmmss = ', rmmss, ' s' 
    139137      IF(lwp) WRITE(numout,*) 
    140       IF(lwp) WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m' 
    141       IF(lwp) WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2' 
    142  
     138      IF(lwp) WRITE(numout,*) '      earth radius                         ra   = ', ra, ' m' 
     139      IF(lwp) WRITE(numout,*) '      gravity                              grav = ', grav , ' m/s^2' 
    143140      IF(lwp) WRITE(numout,*) 
    144       IF(lwp) WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K' 
    145       IF(lwp) WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K' 
    146       IF(lwp) WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K' 
    147       IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
    148  
    149       IF(lwp) WRITE(numout,*) '          reference density and heat capacity now defined in eosbn2.f90' 
     141      IF(lwp) WRITE(numout,*) '      triple point of temperature      rtt      = ', rtt     , ' K' 
     142      IF(lwp) WRITE(numout,*) '      freezing point of water          rt0      = ', rt0     , ' K' 
     143      IF(lwp) WRITE(numout,*) '      melting point of snow            rt0_snow = ', rt0_snow, ' K' 
     144      IF(lwp) WRITE(numout,*) '      melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
     145      IF(lwp) WRITE(numout,*) 
     146      IF(lwp) WRITE(numout,*) '   reference density and heat capacity now defined in eosbn2.f90' 
    150147               
    151148#if defined key_lim3 || defined key_cice 
    … …  
    163160         WRITE(numout,*) 
    164161#if defined key_cice 
    165          WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K' 
     162         WRITE(numout,*) '      thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K' 
    166163#endif 
    167          WRITE(numout,*) '          thermal conductivity of pure ice          = ', rcdic   , ' J/s/m/K' 
    168          WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K' 
    169          WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 
     164         WRITE(numout,*) '      thermal conductivity of pure ice          = ', rcdic   , ' J/s/m/K' 
     165         WRITE(numout,*) '      fresh ice specific heat                   = ', cpic    , ' J/kg/K' 
     166         WRITE(numout,*) '      latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 
    170167#if defined key_lim3 || defined key_cice 
    171          WRITE(numout,*) '          latent heat of subl.  of fresh ice / snow = ', lsub    , ' J/kg' 
     168         WRITE(numout,*) '      latent heat of subl.  of fresh ice / snow = ', lsub    , ' J/kg' 
    172169#else 
    173          WRITE(numout,*) '          density times specific heat for snow      = ', rcpsn   , ' J/m^3/K'  
    174          WRITE(numout,*) '          density times specific heat for ice       = ', rcpic   , ' J/m^3/K' 
    175          WRITE(numout,*) '          volumetric latent heat fusion of sea ice  = ', xlic    , ' J/m'  
    176          WRITE(numout,*) '          latent heat of sublimation of snow        = ', xsn     , ' J/kg'  
     170         WRITE(numout,*) '      density times specific heat for snow      = ', rcpsn   , ' J/m^3/K'  
     171         WRITE(numout,*) '      density times specific heat for ice       = ', rcpic   , ' J/m^3/K' 
     172         WRITE(numout,*) '      volumetric latent heat fusion of sea ice  = ', xlic    , ' J/m'  
     173         WRITE(numout,*) '      latent heat of sublimation of snow        = ', xsn     , ' J/kg'  
    177174#endif 
    178          WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m^3'  
    179          WRITE(numout,*) '          density of sea ice                        = ', rhoic   , ' kg/m^3' 
    180          WRITE(numout,*) '          density of snow                           = ', rhosn   , ' kg/m^3' 
    181          WRITE(numout,*) '          density of freshwater (in melt ponds)     = ', rhofw   , ' kg/m^3' 
    182          WRITE(numout,*) '          emissivity of snow or ice                 = ', emic   
    183          WRITE(numout,*) '          salinity of ice                           = ', sice    , ' psu' 
    184          WRITE(numout,*) '          salinity of sea                           = ', soce    , ' psu' 
    185          WRITE(numout,*) '          latent heat of evaporation (water)        = ', cevap   , ' J/m^3'  
    186          WRITE(numout,*) '          correction factor for solar radiation     = ', srgamma  
    187          WRITE(numout,*) '          von Karman constant                       = ', vkarmn  
    188          WRITE(numout,*) '          Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4' 
     175         WRITE(numout,*) '      volumetric latent heat fusion of snow     = ', xlsn    , ' J/m^3'  
     176         WRITE(numout,*) '      density of sea ice                        = ', rhoic   , ' kg/m^3' 
     177         WRITE(numout,*) '      density of snow                           = ', rhosn   , ' kg/m^3' 
     178         WRITE(numout,*) '      density of freshwater (in melt ponds)     = ', rhofw   , ' kg/m^3' 
     179         WRITE(numout,*) '      emissivity of snow or ice                 = ', emic   
     180         WRITE(numout,*) '      salinity of ice                           = ', sice    , ' psu' 
     181         WRITE(numout,*) '      salinity of sea                           = ', soce    , ' psu' 
     182         WRITE(numout,*) '      latent heat of evaporation (water)        = ', cevap   , ' J/m^3'  
     183         WRITE(numout,*) '      correction factor for solar radiation     = ', srgamma  
     184         WRITE(numout,*) '      von Karman constant                       = ', vkarmn  
     185         WRITE(numout,*) '      Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4' 
    189186         WRITE(numout,*) 
    190          WRITE(numout,*) '          conversion: degre ==> radian          rad = ', rad 
     187         WRITE(numout,*) '      conversion: degre ==> radian          rad = ', rad 
    191188         WRITE(numout,*) 
    192          WRITE(numout,*) '          smallest real computer value       rsmall = ', rsmall 
     189         WRITE(numout,*) '      smallest real computer value       rsmall = ', rsmall 
    193190      ENDIF 
    194191 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r9168 r9169  
    194194      !!---------------------------------------------------------------------- 
    195195      ! 
     196      IF(lwp) THEN 
     197         WRITE(numout,*) 
     198         WRITE(numout,*) 'dyn_spg_init : choice of the surface pressure gradient scheme' 
     199         WRITE(numout,*) '~~~~~~~~~~~~' 
     200      ENDIF 
     201      ! 
    196202      REWIND( numnam_ref )              ! Namelist namdyn_spg in reference namelist : Free surface 
    197203      READ  ( numnam_ref, namdyn_spg, IOSTAT = ios, ERR = 901) 
    … …  
    204210      ! 
    205211      IF(lwp) THEN             ! Namelist print 
    206          WRITE(numout,*) 
    207          WRITE(numout,*) 'dyn_spg_init : choice of the surface pressure gradient scheme' 
    208          WRITE(numout,*) '~~~~~~~~~~~' 
    209          WRITE(numout,*) '     Explicit free surface                  ln_dynspg_exp = ', ln_dynspg_exp 
    210          WRITE(numout,*) '     Free surface with time splitting       ln_dynspg_ts  = ', ln_dynspg_ts 
     212         WRITE(numout,*) '   Namelist : namdyn_spg                    ' 
     213         WRITE(numout,*) '      Explicit free surface                  ln_dynspg_exp = ', ln_dynspg_exp 
     214         WRITE(numout,*) '      Free surface with time splitting       ln_dynspg_ts  = ', ln_dynspg_ts 
    211215      ENDIF 
    212216      !                          ! Control of surface pressure gradient scheme options 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r9124 r9169  
    14241424      ! Print results 
    14251425      IF(lwp) WRITE(numout,*) 
    1426       IF(lwp) WRITE(numout,*) 'dyn_spg_ts : split-explicit free surface' 
    1427       IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     1426      IF(lwp) WRITE(numout,*) 'dyn_spg_ts_init : split-explicit free surface' 
     1427      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    14281428      IF( ln_bt_auto ) THEN 
    1429          IF(lwp) WRITE(numout,*) '     ln_ts_auto=.true. Automatically set nn_baro ' 
     1429         IF(lwp) WRITE(numout,*) '     ln_ts_auto =.true. Automatically set nn_baro ' 
    14301430         IF(lwp) WRITE(numout,*) '     Max. courant number allowed: ', rn_bt_cmax 
    14311431      ELSE 
    1432          IF(lwp) WRITE(numout,*) '     ln_ts_auto=.false.: Use nn_baro in namelist ' 
     1432         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.false.: Use nn_baro in namelist   nn_baro = ', nn_baro 
    14331433      ENDIF 
    14341434 
    14351435      IF(ln_bt_av) THEN 
    1436          IF(lwp) WRITE(numout,*) '     ln_bt_av=.true.  => Time averaging over nn_baro time steps is on ' 
     1436         IF(lwp) WRITE(numout,*) '     ln_bt_av =.true.  ==> Time averaging over nn_baro time steps is on ' 
    14371437      ELSE 
    1438          IF(lwp) WRITE(numout,*) '     ln_bt_av=.false. => No time averaging of barotropic variables ' 
     1438         IF(lwp) WRITE(numout,*) '     ln_bt_av =.false. => No time averaging of barotropic variables ' 
    14391439      ENDIF 
    14401440      ! 
    … …  
    14561456         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_baro' 
    14571457         CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_baro'  
    1458          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1,2' ) 
     1458         CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1, or 2' ) 
    14591459      END SELECT 
    14601460      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r9168 r9169  
    229229         IF( jpnj  == 1             )   ibondj(ii,ij) = 2 
    230230         ibondi(ii,ij) = 0 
    231          IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1 
    232          IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1 
    233          IF( jpni            == 1 )   ibondi(ii,ij) =  2 
     231         IF( MOD(jarea,jpni) ==  1 )   ibondi(ii,ij) = -1 
     232         IF( MOD(jarea,jpni) ==  0 )   ibondi(ii,ij) =  1 
     233         IF( jpni            ==  1 )   ibondi(ii,ij) =  2 
    234234 
    235235         ! Subdomain neighbors 
    … …  
    242242         ilei(ii,ij) = ili - nn_hls 
    243243 
    244          IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) =  1 
    245          IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili 
     244         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 )   ildi(ii,ij) =  1 
     245         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 )   ilei(ii,ij) = ili 
    246246         ildj(ii,ij) =  1  + nn_hls 
    247247         ilej(ii,ij) = ilj - nn_hls 
    248          IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) =  1 
    249          IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj 
     248         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 )   ildj(ii,ij) =  1 
     249         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 )   ilej(ii,ij) = ilj 
    250250 
    251251         ! warning ii*ij (zone) /= nproc (processors)! 
    … …  
    326326            il1 = il1+ifreq 
    327327         END DO 
    328  9400    FORMAT('     ***',20('*************',a3)) 
    329  9403    FORMAT('     *     ',20('         *   ',a3)) 
    330  9401    FORMAT('        ',20('   ',i3,'          ')) 
    331  9402    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   ')) 
    332  9404    FORMAT('     *  ',20('      ',i3,'   *   ')) 
     328 9400    FORMAT('           ***'   ,20('*************',a3)    ) 
     329 9403    FORMAT('           *     ',20('         *   ',a3)    ) 
     330 9401    FORMAT('              '   ,20('   ',i3,'          ') ) 
     331 9402    FORMAT('       ',i3,' *  ',20(i3,'  x',i3,'   *   ') ) 
     332 9404    FORMAT('           *  '   ,20('      ',i3,'   *   ') ) 
    333333      ENDIF 
    334334 
    … …  
    479479      IF(lwp) THEN 
    480480         WRITE(numout,*) 
    481          WRITE(numout,*) ' nproc  = ', nproc 
    482          WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea 
    483          WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso 
    484          WRITE(numout,*) ' nbondi = ', nbondi 
    485          WRITE(numout,*) ' nbondj = ', nbondj 
    486          WRITE(numout,*) ' npolj  = ', npolj 
    487          WRITE(numout,*) ' nperio = ', nperio 
    488          WRITE(numout,*) ' nlci   = ', nlci 
    489          WRITE(numout,*) ' nlcj   = ', nlcj 
    490          WRITE(numout,*) ' nimpp  = ', nimpp 
    491          WRITE(numout,*) ' njmpp  = ', njmpp 
    492          WRITE(numout,*) ' nreci  = ', nreci   
    493          WRITE(numout,*) ' nrecj  = ', nrecj   
    494          WRITE(numout,*) ' nn_hls = ', nn_hls  
     481         WRITE(numout,*) '   resulting internal parameters : ' 
     482         WRITE(numout,*) '      nproc  = ', nproc 
     483         WRITE(numout,*) '      nowe   = ', nowe  , '   noea  =  ', noea 
     484         WRITE(numout,*) '      nono   = ', nono  , '   noso  =  ', noso 
     485         WRITE(numout,*) '      nbondi = ', nbondi 
     486         WRITE(numout,*) '      nbondj = ', nbondj 
     487         WRITE(numout,*) '      npolj  = ', npolj 
     488         WRITE(numout,*) '      nperio = ', nperio 
     489         WRITE(numout,*) '      nlci   = ', nlci 
     490         WRITE(numout,*) '      nlcj   = ', nlcj 
     491         WRITE(numout,*) '      nimpp  = ', nimpp 
     492         WRITE(numout,*) '      njmpp  = ', njmpp 
     493         WRITE(numout,*) '      nreci  = ', nreci   
     494         WRITE(numout,*) '      nrecj  = ', nrecj   
     495         WRITE(numout,*) '      nn_hls = ', nn_hls  
    495496      ENDIF 
    496497  
    497       IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( 'mpp_init: error on cyclicity' ) 
    498  
    499       IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) ) & 
     498      IF( nperio == 1 .AND. jpni /= 1 )   CALL ctl_stop( 'mpp_init: error on cyclicity' ) 
     499 
     500      IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) )   & 
    500501         &                  CALL ctl_stop( ' mpp_init: error jperio = 7 works only with jpni = jpnj = 1' ) 
    501502 
    … …  
    503504      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 
    504505         CALL mpp_ini_north 
    505          IF(lwp) WRITE(numout,*) ' mpp_init : North fold boundary prepared for jpni >1' 
     506         IF(lwp) WRITE(numout,*) 
     507         IF(lwp) WRITE(numout,*) '   ==>>>   North fold boundary prepared for jpni >1' 
    506508      ENDIF 
    507509      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r9168 r9169  
    142142      !                                ! Parameter control 
    143143      IF( ln_dynldf_NONE ) THEN 
    144          IF(lwp) WRITE(numout,*) '   No viscous operator selected. ahmt and ahmf are not allocated' 
     144         IF(lwp) WRITE(numout,*) '   ==>>>   No viscous operator selected. ahmt and ahmf are not allocated' 
    145145         l_ldfdyn_time = .FALSE. 
    146146         RETURN 
    … …  
    173173         ! 
    174174         CASE(   0  )      !==  constant  ==! 
    175             IF(lwp) WRITE(numout,*) '          momentum mixing coef. = constant ' 
     175            IF(lwp) WRITE(numout,*) '   ==>>>   momentum mixing coef. = constant ' 
    176176            ahmt(:,:,:) = zah0 * tmask(:,:,:) 
    177177            ahmf(:,:,:) = zah0 * fmask(:,:,:) 
    178178            ! 
    179179         CASE(  10  )      !==  fixed profile  ==! 
    180             IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( depth )' 
     180            IF(lwp) WRITE(numout,*) '   ==>>>   momentum mixing coef. = F( depth )' 
    181181            ahmt(:,:,1) = zah0 * tmask(:,:,1)                      ! constant surface value 
    182182            ahmf(:,:,1) = zah0 * fmask(:,:,1) 
    … …  
    184184            ! 
    185185         CASE ( -20 )      !== fixed horizontal shape read in file  ==! 
    186             IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F(i,j) read in eddy_viscosity.nc file' 
     186            IF(lwp) WRITE(numout,*) '   ==>>>   momentum mixing coef. = F(i,j) read in eddy_viscosity.nc file' 
    187187            CALL iom_open( 'eddy_viscosity_2D.nc', inum ) 
    188188            CALL iom_get ( inum, jpdom_data, 'ahmt_2d', ahmt(:,:,1) ) 
    … …  
    198198            ! 
    199199         CASE(  20  )      !== fixed horizontal shape  ==! 
    200             IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap. or blp. case)' 
     200            IF(lwp) WRITE(numout,*) '   ==>>>   momentum mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap. or blp. case)' 
    201201            IF( ln_dynldf_lap )   CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor 
    202202            IF( ln_dynldf_blp )   CALL ldf_c2d( 'DYN', 'BLP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor^3 
    203203            ! 
    204204         CASE( -30  )      !== fixed 3D shape read in file  ==! 
    205             IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 
     205            IF(lwp) WRITE(numout,*) '   ==>>>   momentum mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 
    206206            CALL iom_open( 'eddy_viscosity_3D.nc', inum ) 
    207207            CALL iom_get ( inum, jpdom_data, 'ahmt_3d', ahmt ) 
    … …  
    216216            ! 
    217217         CASE(  30  )       !==  fixed 3D shape  ==! 
    218             IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth )' 
     218            IF(lwp) WRITE(numout,*) '   ==>>>   momentum mixing coef. = F( latitude, longitude, depth )' 
    219219            IF( ln_dynldf_lap )   CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor 
    220220            IF( ln_dynldf_blp )   CALL ldf_c2d( 'DYN', 'BLP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor 
    … …  
    223223            ! 
    224224         CASE(  31  )       !==  time varying 3D field  ==! 
    225             IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth , time )' 
    226             IF(lwp) WRITE(numout,*) '                                proportional to the velocity : |u|e/12 or |u|e^3/12' 
     225            IF(lwp) WRITE(numout,*) '   ==>>>   momentum mixing coef. = F( latitude, longitude, depth , time )' 
     226            IF(lwp) WRITE(numout,*) '              proportional to the velocity : |u|e/12 or |u|e^3/12' 
    227227            ! 
    228228            l_ldfdyn_time = .TRUE.     ! will be calculated by call to ldf_dyn routine in step.F90 
    229229            ! 
    230230         CASE(  32  )       !==  time varying 3D field  ==! 
    231             IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth , time )' 
    232             IF(lwp) WRITE(numout,*) '             proportional to the local deformation rate and gridscale (Smagorinsky)' 
    233             IF(lwp) WRITE(numout,*) '                                                             : L^2|D| or L^4|D|/8' 
     231            IF(lwp) WRITE(numout,*) '   ==>>>   momentum mixing coef. = F( latitude, longitude, depth , time )' 
     232            IF(lwp) WRITE(numout,*) '              proportional to the local deformation rate and gridscale (Smagorinsky)' 
     233            IF(lwp) WRITE(numout,*) '                                                                : L^2|D| or L^4|D|/8' 
    234234            ! 
    235235            l_ldfdyn_time = .TRUE.     ! will be calculated by call to ldf_dyn routine in step.F90 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r9168 r9169  
    126126      !!---------------------------------------------------------------------- 
    127127      ! 
    128       !  Choice of lateral tracer physics 
    129       ! ================================= 
    130       ! 
    131       REWIND( numnam_ref )              ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers 
    132       READ  ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901) 
    133 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp ) 
    134       ! 
    135       REWIND( numnam_cfg )              ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers 
    136       READ  ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 ) 
    137 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp ) 
    138       IF(lwm) WRITE ( numond, namtra_ldf ) 
    139       ! 
    140128      IF(lwp) THEN                      ! control print 
    141129         WRITE(numout,*) 
    142130         WRITE(numout,*) 'ldf_tra_init : lateral tracer physics' 
    143131         WRITE(numout,*) '~~~~~~~~~~~~ ' 
    144          WRITE(numout,*) '   Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)' 
     132      ENDIF 
     133      ! 
     134      !  Choice of lateral tracer physics 
     135      ! ================================= 
     136      ! 
     137      REWIND( numnam_ref )              ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers 
     138      READ  ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901) 
     139901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp ) 
     140      REWIND( numnam_cfg )              ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers 
     141      READ  ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 ) 
     142902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp ) 
     143      IF(lwm) WRITE( numond, namtra_ldf ) 
     144      ! 
     145      IF(lwp) THEN                      ! control print 
     146         WRITE(numout,*) '   Namelist : namtra_ldf --- lateral mixing parameters (type, direction, coefficients)' 
    145147         WRITE(numout,*) '      type :' 
    146148         WRITE(numout,*) '         no explicit diffusion                   ln_traldf_NONE  = ', ln_traldf_NONE 
    … …  
    166168      ! 
    167169      IF( ln_traldf_NONE ) THEN 
    168          IF(lwp) WRITE(numout,*) '   No diffusive operator selected. ahtu and ahtv are not allocated' 
     170         IF(lwp) WRITE(numout,*) '   ==>>>   No diffusive operator selected. ahtu and ahtv are not allocated' 
    169171         l_ldftra_time = .FALSE. 
    170172         RETURN 
    … …  
    196198         ! 
    197199         CASE(   0  )      !==  constant  ==! 
    198             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant = ', rn_aht_0 
     200            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = constant = ', rn_aht_0 
    199201            ahtu(:,:,:) = zah0 * umask(:,:,:) 
    200202            ahtv(:,:,:) = zah0 * vmask(:,:,:) 
    201203            ! 
    202204         CASE(  10  )      !==  fixed profile  ==! 
    203             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )' 
     205            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = F( depth )' 
    204206            ahtu(:,:,1) = zah0 * umask(:,:,1)                      ! constant surface value 
    205207            ahtv(:,:,1) = zah0 * vmask(:,:,1) 
    … …  
    207209            ! 
    208210         CASE ( -20 )      !== fixed horizontal shape read in file  ==! 
    209             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j) read in eddy_diffusivity.nc file' 
     211            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = F(i,j) read in eddy_diffusivity.nc file' 
    210212            CALL iom_open( 'eddy_diffusivity_2D.nc', inum ) 
    211213            CALL iom_get ( inum, jpdom_data, 'ahtu_2D', ahtu(:,:,1) ) 
    … …  
    218220            ! 
    219221         CASE(  20  )      !== fixed horizontal shape  ==! 
    220             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or blp case)' 
     222            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or blp case)' 
    221223            IF( ln_traldf_lap )   CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor 
    222224            IF( ln_traldf_blp )   CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor 
    223225            ! 
    224226         CASE(  21  )      !==  time varying 2D field  ==! 
    225             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, time )' 
    226             IF(lwp) WRITE(numout,*) '                              = F( growth rate of baroclinic instability )' 
    227             IF(lwp) WRITE(numout,*) '                              min value = 0.1 * rn_aht_0' 
    228             IF(lwp) WRITE(numout,*) '                              max value = rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)' 
    229             IF(lwp) WRITE(numout,*) '                              increased to rn_aht_0 within 20N-20S' 
     227            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = F( latitude, longitude, time )' 
     228            IF(lwp) WRITE(numout,*) '                               = F( growth rate of baroclinic instability )' 
     229            IF(lwp) WRITE(numout,*) '                               min value = 0.1 * rn_aht_0' 
     230            IF(lwp) WRITE(numout,*) '                               max value = rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)' 
     231            IF(lwp) WRITE(numout,*) '                               increased to rn_aht_0 within 20N-20S' 
    230232            ! 
    231233            l_ldftra_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90 
    … …  
    236238            ! 
    237239         CASE( -30  )      !== fixed 3D shape read in file  ==! 
    238             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j,k) read in eddy_diffusivity.nc file' 
     240            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = F(i,j,k) read in eddy_diffusivity.nc file' 
    239241            CALL iom_open( 'eddy_diffusivity_3D.nc', inum ) 
    240242            CALL iom_get ( inum, jpdom_data, 'ahtu_3D', ahtu ) 
    … …  
    247249            ! 
    248250         CASE(  30  )      !==  fixed 3D shape  ==! 
    249             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth )' 
     251            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = F( latitude, longitude, depth )' 
    250252            IF( ln_traldf_lap )   CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor 
    251253            IF( ln_traldf_blp )   CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor 
    … …  
    254256            ! 
    255257         CASE(  31  )      !==  time varying 3D field  ==! 
    256             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth , time )' 
    257             IF(lwp) WRITE(numout,*) '                                proportional to the velocity : |u|e/12 or |u|e^3/12' 
     258            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = F( latitude, longitude, depth , time )' 
     259            IF(lwp) WRITE(numout,*) '                                 proportional to the velocity : |u|e/12 or |u|e^3/12' 
    258260            ! 
    259261            l_ldftra_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90 
    … …  
    382384      !!---------------------------------------------------------------------- 
    383385      ! 
     386      IF(lwp) THEN                      ! control print 
     387         WRITE(numout,*) 
     388         WRITE(numout,*) 'ldf_eiv_init : eddy induced velocity parametrization' 
     389         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     390      ENDIF 
     391      ! 
    384392      REWIND( numnam_ref )              ! Namelist namtra_ldfeiv in reference namelist : eddy induced velocity param. 
    385393      READ  ( numnam_ref, namtra_ldfeiv, IOSTAT = ios, ERR = 901) 
    … …  
    392400 
    393401      IF(lwp) THEN                      ! control print 
    394          WRITE(numout,*) 
    395          WRITE(numout,*) 'ldf_eiv_init : eddy induced velocity parametrization' 
    396          WRITE(numout,*) '~~~~~~~~~~~~ ' 
    397402         WRITE(numout,*) '   Namelist namtra_ldfeiv : ' 
    398403         WRITE(numout,*) '      Eddy Induced Velocity (eiv) param.      ln_ldfeiv     = ', ln_ldfeiv 
    … …  
    415420         ! 
    416421         CASE(   0  )      !==  constant  ==! 
    417             IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = constant = ', rn_aeiv_0 
     422            IF(lwp) WRITE(numout,*) '   ==>>>   eddy induced velocity coef. = constant = ', rn_aeiv_0 
    418423            aeiu(:,:,:) = rn_aeiv_0 
    419424            aeiv(:,:,:) = rn_aeiv_0 
    420425            ! 
    421426         CASE(  10  )      !==  fixed profile  ==! 
    422             IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = F( depth )' 
     427            IF(lwp) WRITE(numout,*) '   ==>>>   eddy induced velocity coef. = F( depth )' 
    423428            aeiu(:,:,1) = rn_aeiv_0                                ! constant surface value 
    424429            aeiv(:,:,1) = rn_aeiv_0 
    … …  
    426431            ! 
    427432         CASE ( -20 )      !== fixed horizontal shape read in file  ==! 
    428             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j) read in eddy_diffusivity_2D.nc file' 
     433            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = F(i,j) read in eddy_diffusivity_2D.nc file' 
    429434            CALL iom_open ( 'eddy_induced_velocity_2D.nc', inum ) 
    430435            CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu(:,:,1) ) 
    … …  
    437442            ! 
    438443         CASE(  20  )      !== fixed horizontal shape  ==! 
    439             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or bilap case)' 
     444            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or bilap case)' 
    440445            CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv )    ! surface value proportional to scale factor 
    441446            ! 
    442447         CASE(  21  )       !==  time varying 2D field  ==! 
    443             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, time )' 
    444             IF(lwp) WRITE(numout,*) '                              = F( growth rate of baroclinic instability )' 
     448            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = F( latitude, longitude, time )' 
     449            IF(lwp) WRITE(numout,*) '                               = F( growth rate of baroclinic instability )' 
    445450            ! 
    446451            l_ldfeiv_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90 
    447452            ! 
    448453         CASE( -30  )      !== fixed 3D shape read in file  ==! 
    449             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 
     454            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 
    450455            CALL iom_open ( 'eddy_induced_velocity_3D.nc', inum ) 
    451456            CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu ) 
    … …  
    454459            ! 
    455460         CASE(  30  )       !==  fixed 3D shape  ==! 
    456             IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth )' 
     461            IF(lwp) WRITE(numout,*) '   ==>>>   tracer mixing coef. = F( latitude, longitude, depth )' 
    457462            CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv )    ! surface value proportional to scale factor 
    458463            !                                                 ! reduction with depth 
    … …  
    464469         ! 
    465470      ELSE 
    466           IF(lwp) WRITE(numout,*) '   eddy induced velocity param is NOT used neither diagnosed' 
     471          IF(lwp) WRITE(numout,*) '   ==>>>   eddy induced velocity param is NOT used neither diagnosed' 
    467472          ln_ldfeiv_dia = .FALSE. 
    468473      ENDIF 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r9168 r9169  
    155155         WRITE(numout,*) '               Stokes drift corr. to vert. velocity ln_sdw        = ', ln_sdw 
    156156         WRITE(numout,*) '                  vertical parametrization          nn_sdrift     = ', nn_sdrift 
    157          WRITE(numout,*) '               wave modified ocean stress           ln_tauwoc      = ', ln_tauwoc 
     157         WRITE(numout,*) '               wave modified ocean stress           ln_tauwoc     = ', ln_tauwoc 
    158158         WRITE(numout,*) '               wave modified ocean stress component ln_tauw       = ', ln_tauw 
    159159         WRITE(numout,*) '               Stokes coriolis term                 ln_stcor      = ', ln_stcor 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r9168 r9169  
    241241      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrnfcl     
    242242      REAL(wp), DIMENSION(:,:  ), ALLOCATABLE :: zrnf 
    243       ! 
     243      !! 
    244244      NAMELIST/namsbc_rnf/ cn_dir            , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   & 
    245245         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   & 
    … …  
    292292         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow) 
    293293         IF(lwp) WRITE(numout,*) 
    294          IF(lwp) WRITE(numout,*) '          runoffs inflow read in a file' 
     294         IF(lwp) WRITE(numout,*) '   ==>>>   runoffs inflow read in a file' 
    295295         IF( ierror > 0 ) THEN 
    296296            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_rnf structure' )   ;   RETURN 
    … …  
    303303      IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure 
    304304         IF(lwp) WRITE(numout,*) 
    305          IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file' 
     305         IF(lwp) WRITE(numout,*) '   ==>>>   runoffs temperatures read in a file' 
    306306         ALLOCATE( sf_t_rnf(1), STAT=ierror  ) 
    307307         IF( ierror > 0 ) THEN 
    … …  
    315315      IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures 
    316316         IF(lwp) WRITE(numout,*) 
    317          IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file' 
     317         IF(lwp) WRITE(numout,*) '   ==>>>   runoffs salinities read in a file' 
    318318         ALLOCATE( sf_s_rnf(1), STAT=ierror  ) 
    319319         IF( ierror > 0 ) THEN 
    … …  
    327327      IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file 
    328328         IF(lwp) WRITE(numout,*) 
    329          IF(lwp) WRITE(numout,*) '          runoffs depth read in a file' 
     329         IF(lwp) WRITE(numout,*) '   ==>>>   runoffs depth read in a file' 
    330330         rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 
    331331         IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year  
    … …  
    364364         ! 
    365365         IF(lwp) WRITE(numout,*) 
    366          IF(lwp) WRITE(numout,*) '    depth of runoff computed once from max value of runoff' 
    367          IF(lwp) WRITE(numout,*) '    max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max 
    368          IF(lwp) WRITE(numout,*) '    depth over which runoffs is spread                        rn_dep_max = ', rn_dep_max 
    369          IF(lwp) WRITE(numout,*) '     create (=1) a runoff depth file or not (=0)      nn_rnf_depth_file  = ', nn_rnf_depth_file 
     366         IF(lwp) WRITE(numout,*) '   ==>>>  depth of runoff computed once from max value of runoff' 
     367         IF(lwp) WRITE(numout,*) '        max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max 
     368         IF(lwp) WRITE(numout,*) '        depth over which runoffs is spread                        rn_dep_max = ', rn_dep_max 
     369         IF(lwp) WRITE(numout,*) '        create (=1) a runoff depth file or not (=0)      nn_rnf_depth_file  = ', nn_rnf_depth_file 
    370370 
    371371         CALL iom_open( TRIM( sn_rnf%clname ), inum )    !  open runoff file 
    … …  
    420420         ! 
    421421         IF( nn_rnf_depth_file == 1 ) THEN      !  save  output nb levels for runoff 
    422             IF(lwp) WRITE(numout,*) '              create runoff depht file' 
     422            IF(lwp) WRITE(numout,*) '   ==>>>   create runoff depht file' 
    423423            CALL iom_open  ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
    424424            CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf ) 
    … …  
    453453         ENDIF 
    454454         IF(lwp) WRITE(numout,*) 
    455          IF(lwp) WRITE(numout,*) '          Specific treatment used in vicinity of river mouths :' 
     455         IF(lwp) WRITE(numout,*) '   ==>>>   Specific treatment used in vicinity of river mouths :' 
    456456         IF(lwp) WRITE(numout,*) '             - Increase Kz in surface layers (if rn_hrnf > 0 )' 
    457457         IF(lwp) WRITE(numout,*) '               by ', rn_avt_rnf,' m2/s  over ', nkrnf, ' w-levels' 
    … …  
    463463      ELSE                                      ! No treatment at river mouths 
    464464         IF(lwp) WRITE(numout,*) 
    465          IF(lwp) WRITE(numout,*) '          No specific treatment at river mouths' 
     465         IF(lwp) WRITE(numout,*) '   ==>>>   No specific treatment at river mouths' 
    466466         rnfmsk  (:,:) = 0._wp 
    467467         rnfmsk_z(:)   = 0._wp 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r9168 r9169  
    158158      !!---------------------------------------------------------------------- 
    159159      ! 
    160   
     160      IF(lwp) THEN 
     161         WRITE(numout,*) 
     162         WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term ' 
     163         WRITE(numout,*) '~~~~~~~ ' 
     164      ENDIF 
     165      !  
    161166      REWIND( numnam_ref )              ! Namelist namsbc_ssr in reference namelist :  
    162167      READ  ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901) 
    … …  
    169174 
    170175      IF(lwp) THEN                 !* control print 
    171          WRITE(numout,*) 
    172          WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term ' 
    173          WRITE(numout,*) '~~~~~~~ ' 
    174176         WRITE(numout,*) '   Namelist namsbc_ssr :' 
    175177         WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr        = ', nn_sstr 
    176178         WRITE(numout,*) '         dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K' 
    177          WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr        = ', nn_sssr 
     179         WRITE(numout,*) '      SSS damping term (Yes=1, salt   flux)  nn_sssr        = ', nn_sssr 
    178180         WRITE(numout,*) '                       (Yes=2, volume flux) ' 
    179181         WRITE(numout,*) '         dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day' 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r9168 r9169  
    12721272      CASE( np_teos10 )                       !==  polynomial TEOS-10  ==! 
    12731273         IF(lwp) WRITE(numout,*) 
    1274          IF(lwp) WRITE(numout,*) '          use of TEOS-10 equation of state (cons. temp. and abs. salinity)' 
     1274         IF(lwp) WRITE(numout,*) '   ==>>>   use of TEOS-10 equation of state (cons. temp. and abs. salinity)' 
    12751275         ! 
    12761276         l_useCT = .TRUE.                          ! model temperature is Conservative temperature  
    … …  
    14641464         ! 
    14651465         IF(lwp) WRITE(numout,*) 
    1466          IF(lwp) WRITE(numout,*) '          use of EOS-80 equation of state (pot. temp. and pract. salinity)' 
     1466         IF(lwp) WRITE(numout,*) '   ==>>>   use of EOS-80 equation of state (pot. temp. and pract. salinity)' 
    14671467         ! 
    14681468         l_useCT = .FALSE.                         ! model temperature is Potential temperature 
    … …  
    16551655         IF(lwp) THEN 
    16561656            WRITE(numout,*) 
    1657             WRITE(numout,*) '          use of simplified eos:    rhd(dT=T-10,dS=S-35,Z) = ' 
    1658             WRITE(numout,*) '             [-a0*(1+lambda1/2*dT+mu1*Z)*dT + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS]/rau0' 
    1659             WRITE(numout,*) 
    1660             WRITE(numout,*) '             thermal exp. coef.    rn_a0      = ', rn_a0 
    1661             WRITE(numout,*) '             saline  cont. coef.   rn_b0      = ', rn_b0 
    1662             WRITE(numout,*) '             cabbeling coef.       rn_lambda1 = ', rn_lambda1 
    1663             WRITE(numout,*) '             cabbeling coef.       rn_lambda2 = ', rn_lambda2 
    1664             WRITE(numout,*) '             thermobar. coef.      rn_mu1     = ', rn_mu1 
    1665             WRITE(numout,*) '             thermobar. coef.      rn_mu2     = ', rn_mu2 
    1666             WRITE(numout,*) '             2nd cabbel. coef.     rn_nu      = ', rn_nu 
    1667             WRITE(numout,*) '               Caution: rn_beta0=0 incompatible with ddm parameterization ' 
     1657            WRITE(numout,*) '   ==>>>   use of simplified eos:    ' 
     1658            WRITE(numout,*) '              rhd(dT=T-10,dS=S-35,Z) = [-a0*(1+lambda1/2*dT+mu1*Z)*dT ' 
     1659            WRITE(numout,*) '                                       + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / rau0' 
     1660            WRITE(numout,*) '              with the following coefficients :' 
     1661            WRITE(numout,*) '                 thermal exp. coef.    rn_a0      = ', rn_a0 
     1662            WRITE(numout,*) '                 saline  cont. coef.   rn_b0      = ', rn_b0 
     1663            WRITE(numout,*) '                 cabbeling coef.       rn_lambda1 = ', rn_lambda1 
     1664            WRITE(numout,*) '                 cabbeling coef.       rn_lambda2 = ', rn_lambda2 
     1665            WRITE(numout,*) '                 thermobar. coef.      rn_mu1     = ', rn_mu1 
     1666            WRITE(numout,*) '                 thermobar. coef.      rn_mu2     = ', rn_mu2 
     1667            WRITE(numout,*) '                 2nd cabbel. coef.     rn_nu      = ', rn_nu 
     1668            WRITE(numout,*) '              Caution: rn_beta0=0 incompatible with ddm parameterization ' 
    16681669         ENDIF 
    16691670         l_useCT = .TRUE.          ! Use conservative temperature 
    … …  
    16821683      IF(lwp) THEN 
    16831684         IF( l_useCT )   THEN 
    1684             WRITE(numout,*) '             model uses Conservative Temperature' 
    1685             WRITE(numout,*) '             Important: model must be initialized with CT and SA fields' 
     1685            WRITE(numout,*) 
     1686            WRITE(numout,*) '   ==>>>   model uses Conservative Temperature' 
     1687            WRITE(numout,*) '           Important: model must be initialized with CT and SA fields' 
    16861688         ELSE 
    1687             WRITE(numout,*) '             model does not use Conservative Temperature' 
     1689            WRITE(numout,*) 
     1690            WRITE(numout,*) '   ==>>>   model does not use Conservative Temperature' 
    16881691         ENDIF 
    16891692      ENDIF 
    16901693      ! 
    16911694      IF(lwp) WRITE(numout,*) 
    1692       IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3' 
    1693       IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg' 
    1694       IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin' 
    1695       IF(lwp) WRITE(numout,*) '          rau0 * rcp                       rau0_rcp = ', rau0_rcp 
    1696       IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp 
     1695      IF(lwp) WRITE(numout,*) '   Associated physical constant' 
     1696      IF(lwp) WRITE(numout,*) '      volumic mass of reference           rau0  = ', rau0   , ' kg/m^3' 
     1697      IF(lwp) WRITE(numout,*) '      1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg' 
     1698      IF(lwp) WRITE(numout,*) '      ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin' 
     1699      IF(lwp) WRITE(numout,*) '      rau0 * rcp                       rau0_rcp = ', rau0_rcp 
     1700      IF(lwp) WRITE(numout,*) '      1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp 
    16971701      ! 
    16981702   END SUBROUTINE eos_init 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r9168 r9169  
    379379      CASE( np_RGB , np_RGBc )         !==  Red-Green-Blue light penetration  ==! 
    380380         !                              
    381          IF(lwp)   WRITE(numout,*) '   R-G-B   light penetration ' 
     381         IF(lwp)   WRITE(numout,*) '   ==>>>   R-G-B   light penetration ' 
    382382         ! 
    383383         CALL trc_oce_rgb( rkrgb )                 ! tabulated attenuation coef. 
    … …  
    388388         ! 
    389389         IF( nqsr == np_RGBc ) THEN                ! Chl data : set sf_chl structure 
    390             IF(lwp) WRITE(numout,*) '        Chlorophyll read in a file' 
     390            IF(lwp) WRITE(numout,*) '   ==>>>   Chlorophyll read in a file' 
    391391            ALLOCATE( sf_chl(1), STAT=ierror ) 
    392392            IF( ierror > 0 ) THEN 
    … …  
    400400         ENDIF 
    401401         IF( nqsr == np_RGB ) THEN                 ! constant Chl 
    402             IF(lwp) WRITE(numout,*) '        Constant Chlorophyll concentration = 0.05' 
     402            IF(lwp) WRITE(numout,*) '   ==>>>   Constant Chlorophyll concentration = 0.05' 
    403403         ENDIF 
    404404         ! 
    405405      CASE( np_2BD )                   !==  2 bands light penetration  ==! 
    406406         ! 
    407          IF(lwp)  WRITE(numout,*) '   2 bands light penetration' 
     407         IF(lwp)  WRITE(numout,*) '   ==>>>   2 bands light penetration' 
    408408         ! 
    409409         nksr = trc_oce_ext_lev( rn_si1, 100._wp )    ! level of light extinction 
    … …  
    412412      CASE( np_BIO )                   !==  BIO light penetration  ==! 
    413413         ! 
    414          IF(lwp) WRITE(numout,*) '   bio-model light penetration' 
     414         IF(lwp) WRITE(numout,*) '   ==>>>   bio-model light penetration' 
    415415         IF( .NOT.lk_top )   CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' ) 
    416416         ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_nam.F90

    r9124 r9169  
    104104      kperio = 0                    ! GYRE configuration : closed domain 
    105105      ! 
    106       WRITE(ldtxt(ii),*) '   '                                                                        ;   ii = ii + 1 
    107       WRITE(ldtxt(ii),*) '   Lateral b.c. of the global domain set to closed     jperio = ', kperio   ;   ii = ii + 1 
     106      WRITE(ldtxt(ii),*) '   '                                                                            ;   ii = ii + 1 
     107      WRITE(ldtxt(ii),*) '   Lateral b.c. of the global domain set to closed     jperio = ', kperio       ;   ii = ii + 1 
    108108      ! 
    109109   END SUBROUTINE usr_def_nam 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfphy.F90

    r9108 r9169  
    8383      !!---------------------------------------------------------------------- 
    8484      ! 
     85      IF(lwp) THEN 
     86         WRITE(numout,*) 
     87         WRITE(numout,*) 'zdf_phy_init: ocean vertical physics' 
     88         WRITE(numout,*) '~~~~~~~~~~~~' 
     89      ENDIF 
     90      ! 
    8591      !                           !==  Namelist  ==! 
    8692      REWIND( numnam_ref )              ! Namelist namzdf in reference namelist : Vertical mixing parameters 
    … …  
    94100      ! 
    95101      IF(lwp) THEN                      ! Parameter print 
    96          WRITE(numout,*) 
    97          WRITE(numout,*) 'zdf_phy_init: vertical physics' 
    98          WRITE(numout,*) '~~~~~~~~~~~~' 
    99102         WRITE(numout,*) '   Namelist namzdf : set vertical mixing mixing parameters' 
    100103         WRITE(numout,*) '      vertical closure scheme' 
    … …  
    163166      IF(lwp) THEN 
    164167         WRITE(numout,*) 
    165          IF    ( ln_zdfnpc ) THEN  ;   WRITE(numout,*) '      convection: use non penetrative convective scheme' 
    166          ELSEIF( ln_zdfevd ) THEN  ;   WRITE(numout,*) '      convection: use enhanced vertical diffusion scheme' 
    167          ELSE                      ;   WRITE(numout,*) '      convection: no specific scheme used' 
     168         IF    ( ln_zdfnpc ) THEN  ;   WRITE(numout,*) '   ==>>>   convection: use non penetrative convective scheme' 
     169         ELSEIF( ln_zdfevd ) THEN  ;   WRITE(numout,*) '   ==>>>   convection: use enhanced vertical diffusion scheme' 
     170         ELSE                      ;   WRITE(numout,*) '   ==>>>   convection: no specific scheme used' 
    168171         ENDIF 
    169172      ENDIF 
    … …  
    171174      IF(lwp) THEN               !==  Double Diffusion Mixing parameterization  ==!   (ddm) 
    172175         WRITE(numout,*) 
    173          IF( ln_zdfddm ) THEN   ;   WRITE(numout,*) '      use double diffusive mixing: avs /= avt' 
    174          ELSE                   ;   WRITE(numout,*) '      No  double diffusive mixing: avs = avt' 
     176         IF( ln_zdfddm ) THEN   ;   WRITE(numout,*) '   ==>>>   use double diffusive mixing: avs /= avt' 
     177         ELSE                   ;   WRITE(numout,*) '   ==>>>   No  double diffusive mixing: avs = avt' 
    175178         ENDIF 
    176179      ENDIF 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r9104 r9169  
    678678         WRITE(numout,*) '          type of tke penetration profile            nn_htau   = ', nn_htau 
    679679         WRITE(numout,*) '          fraction of TKE that penetrates            rn_efr    = ', rn_efr 
    680          WRITE(numout,*) 
    681680         IF( ln_drg ) THEN 
     681            WRITE(numout,*) 
    682682            WRITE(numout,*) '   Namelist namdrg_top/_bot:   used values:' 
    683683            WRITE(numout,*) '      top    ocean cavity roughness (m)          rn_z0(_top)= ', r_z0_top 
    … …  
    685685         ENDIF 
    686686         WRITE(numout,*) 
    687          WRITE(numout,*) 
    688          WRITE(numout,*) '   ==>> critical Richardson nb with your parameters  ri_cri = ', ri_cri 
     687         WRITE(numout,*) '   ==>>   critical Richardson nb with your parameters  ri_cri = ', ri_cri 
    689688         WRITE(numout,*) 
    690689      ENDIF 
    … …  
    693692         rn_emin  = 1.e-10_wp             ! specific values of rn_emin & rmxl_min are used 
    694693         rmxl_min = 1.e-03_wp             ! associated avt minimum = molecular salt diffusivity (10^-9 m2/s) 
    695          IF(lwp) WRITE(numout,*) '      Internal wave-driven mixing case:   force   rn_emin = 1.e-10 and rmxl_min = 1.e-3 ' 
     694         IF(lwp) WRITE(numout,*) '   ==>>   Internal wave-driven mixing case:   force   rn_emin = 1.e-10 and rmxl_min = 1.e-3' 
    696695      ELSE                          ! standard case : associated avt minimum = molecular viscosity (10^-6 m2/s) 
    697696         rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) )    ! resulting minimum length to recover molecular viscosity 
    698          IF(lwp) WRITE(numout,*) '      minimum mixing length with your parameters rmxl_min = ', rmxl_min 
     697         IF(lwp) WRITE(numout,*) '   ==>>   minimum mixing length with your parameters rmxl_min = ', rmxl_min 
    699698      ENDIF 
    700699      ! 
    … …  
    709708      ! 
    710709      IF( ln_mxl0 ) THEN 
    711          IF(lwp) WRITE(numout,*) '   use a surface mixing length = F(stress) :   set rn_mxl0 = rmxl_min' 
     710         IF(lwp) WRITE(numout,*) 
     711         IF(lwp) WRITE(numout,*) '   ==>>   use a surface mixing length = F(stress) :   set rn_mxl0 = rmxl_min' 
    712712         rn_mxl0 = rmxl_min 
    713713      ENDIF 
    … …  
    763763               CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl ) 
    764764            ELSE                                          ! start TKE from rest 
     765               IF(lwp) WRITE(numout,*) 
    765766               IF(lwp) WRITE(numout,*) '   ==>>   previous run without TKE scheme, set en to background values' 
    766767               en   (:,:,:) = rn_emin * wmask(:,:,:) 
    … …  
    769770            ENDIF 
    770771         ELSE                                   !* Start from rest 
     772            IF(lwp) WRITE(numout,*) 
    771773            IF(lwp) WRITE(numout,*) '   ==>>   start from rest: set en to the background value' 
    772774            en   (:,:,:) = rn_emin * wmask(:,:,:) 
    … …  
    777779      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
    778780         !                                   ! ------------------- 
    779          IF(lwp) WRITE(numout,*) '---- tke-rst ----' 
     781         IF(lwp) WRITE(numout,*) '---- tke_rst ----' 
    780782         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en    ) 
    781783         CALL iom_rstput( kt, nitrst, numrow, 'avt_k', avt_k ) 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r9168 r9169  
    395395         WRITE(numout,*) '                       NEMO team' 
    396396         WRITE(numout,*) '            Ocean General Circulation Model' 
    397          WRITE(numout,*) '                NEMO version 3.7  (2016) ' 
     397         WRITE(numout,*) '                NEMO version 4.0  (2017) ' 
    398398         WRITE(numout,*) 
    399399         WRITE(numout,*) 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90

    r9019 r9169  
    115115      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    116116901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    117       ! 
    118117      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    119118      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    120 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
     119902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    121120      ! 
    122121      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints 
    123122      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    124 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    125  
     123903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    126124      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark 
    127125      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    128 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
     126904   IF( ios >  0 )  CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    129127 
    130128      !                             !--------------------------! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAO_SRC/sao_data.F90

    r7646 r9169  
    3939      NAMELIST/namsao/sao_files, nn_sao_idx, nn_sao_freq 
    4040      !!---------------------------------------------------------------------- 
     41      IF(lwp) THEN 
     42         WRITE(numout,*) 
     43         WRITE(numout,*) 'sao_data_init : offline obs operator initialization' 
     44         WRITE(numout,*) '~~~~~~~~~~~~~' 
     45      ENDIF 
    4146 
    4247      ! Standard offline obs_oper initialisation 
    43       n_files = 0                   ! number of files to cycle through 
    44       sao_files(:) = ''             ! list of files to read in 
    45       nn_sao_idx(:) = 0             ! list of indices inside each file 
    46       nn_sao_freq = -1              ! input frequency in time steps 
     48      n_files       =  0         ! number of files to cycle through 
     49      sao_files(:)  = ''         ! list of files to read in 
     50      nn_sao_idx(:) =  0         ! list of indices inside each file 
     51      nn_sao_freq   = -1         ! input frequency in time steps 
    4752 
    4853      ! Standard offline obs_oper settings 
    4954      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
    5055      READ  ( numnam_ref, namsao, IOSTAT = ios, ERR = 901 ) 
    51 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in reference namelist', .TRUE. ) 
    52       ! 
     56901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsao in reference namelist', .TRUE. ) 
    5357      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark 
    5458      READ  ( numnam_cfg, namsao, IOSTAT = ios, ERR = 902 ) 
    55 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in configuration namelist', .TRUE. ) 
     59902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namsao in configuration namelist', .TRUE. ) 
    5660      
    5761      lmask(:) = .FALSE.               ! count input files 
    58       WHERE (sao_files(:) /= '') lmask(:) = .TRUE. 
     62      WHERE( sao_files(:) /= '' )  lmask(:) = .TRUE. 
    5963      n_files = COUNT(lmask) 
    6064      ! 
    … …  
    6468      ! 
    6569      IF(lwp) THEN                     ! Print summary of settings 
    66          WRITE(numout,*) 
    67          WRITE(numout,*) 'offline obs_oper : Initialization' 
    68          WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 
    6970         WRITE(numout,*) '   Namelist namsao : set stand alone obs_oper parameters' 
    7071         DO jf = 1, n_files 
    71             WRITE(numout,'(1X,2A)') '   Input forecast file name          forecastfile = ', TRIM(sao_files(jf)) 
    72             WRITE(numout,*) '   Input forecast file index        forecastindex = ', nn_sao_idx(jf) 
     72            WRITE(numout,'(1X,2A)') '      Input forecast file name         forecastfile = ', TRIM(sao_files(jf)) 
     73            WRITE(numout,*)         '      Input forecast file index        forecastindex = ', nn_sao_idx(jf) 
    7374         END DO 
    7475      END IF 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r9124 r9169  
    194194      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints 
    195195      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    196 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    197       ! 
     196901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    198197      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    199198      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    200 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
     199902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    201200      ! 
    202201      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints 
    203202      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    204 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    205  
     203903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    206204      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark 
    207205      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    208 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
     206904   IF( ios >  0 )  CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    209207 
    210208      !                             !--------------------------! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90

    r9161 r9169  
    44   !! Off-line : interpolation of the physical fields 
    55   !!====================================================================== 
    6    !! History :  
    7    !!   NEMO         3.4  ! 2012-03 First version by S. Alderson  
    8    !!                     !         Heavily derived from Christian's dtadyn routine 
    9    !!                     !         in OFF_SRC 
    10    !!---------------------------------------------------------------------- 
    11  
    12    !!---------------------------------------------------------------------- 
    13    !!   sbc_ssm_init : initialization, namelist read, and SAVEs control 
    14    !!   sbc_ssm      : Interpolation of the fields 
    15    !!---------------------------------------------------------------------- 
    16    USE oce             ! ocean dynamics and tracers variables 
    17    USE c1d             ! 1D configuration: lk_c1d 
    18    USE dom_oce         ! ocean domain: variables 
    19    USE zdf_oce         ! ocean vertical physics: variables 
    20    USE sbc_oce         ! surface module: variables 
    21    USE phycst          ! physical constants 
    22    USE eosbn2          ! equation of state - Brunt Vaisala frequency 
    23    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    24    USE zpshde          ! z-coord. with partial steps: horizontal derivatives 
    25    USE closea          ! for ln_closea 
     6   !! History :  3.4  ! 2012-03 (S. Alderson)  original code 
     7   !!---------------------------------------------------------------------- 
     8 
     9   !!---------------------------------------------------------------------- 
     10   !!   sbc_ssm_init  : initialization, namelist read, and SAVEs control 
     11   !!   sbc_ssm       : Interpolation of the fields 
     12   !!---------------------------------------------------------------------- 
     13   USE oce            ! ocean dynamics and tracers variables 
     14   USE c1d            ! 1D configuration: lk_c1d 
     15   USE dom_oce        ! ocean domain: variables 
     16   USE zdf_oce        ! ocean vertical physics: variables 
     17   USE sbc_oce        ! surface module: variables 
     18   USE phycst         ! physical constants 
     19   USE eosbn2         ! equation of state - Brunt Vaisala frequency 
     20   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     21   USE zpshde         ! z-coord. with partial steps: horizontal derivatives 
     22   USE closea         ! for ln_closea 
    2623   ! 
    27    USE in_out_manager  ! I/O manager 
    28    USE iom             ! I/O library 
    29    USE lib_mpp         ! distributed memory computing library 
    30    USE prtctl          ! print control 
    31    USE fldread         ! read input fields  
    32    USE timing          ! Timing 
     24   USE in_out_manager ! I/O manager 
     25   USE iom            ! I/O library 
     26   USE lib_mpp        ! distributed memory computing library 
     27   USE prtctl         ! print control 
     28   USE fldread        ! read input fields  
     29   USE timing         ! Timing 
    3330 
    3431   IMPLICIT NONE 
    … …  
    3835   PUBLIC   sbc_ssm        ! called by sbc 
    3936 
    40    CHARACTER(len=100)   ::   cn_dir        !: Root directory for location of ssm files 
    41    LOGICAL              ::   ln_3d_uve     !: specify whether input velocity data is 3D 
    42    LOGICAL              ::   ln_read_frq   !: specify whether we must read frq or not 
    43    LOGICAL              ::   l_sasread     !: Ice intilisation: read a file (.TRUE.) or anaytical initilaistion in namelist &namsbc_sas 
    44    LOGICAL              ::   l_initdone = .false. 
     37   CHARACTER(len=100) ::   cn_dir        ! Root directory for location of ssm files 
     38   LOGICAL            ::   ln_3d_uve     ! specify whether input velocity data is 3D 
     39   LOGICAL            ::   ln_read_frq   ! specify whether we must read frq or not 
     40    
     41   LOGICAL            ::   l_sasread     ! Ice intilisation: =T read a file ; =F anaytical initilaistion 
     42   LOGICAL            ::   l_initdone = .false. 
    4543   INTEGER     ::   nfld_3d 
    4644   INTEGER     ::   nfld_2d 
    … …  
    162160      !!                  ***  ROUTINE sbc_ssm_init  *** 
    163161      !! 
    164       !! ** Purpose :   Initialisation of the dynamical data      
    165       !! ** Method  : - read the data namsbc_ssm namelist 
    166       !! 
    167       !! ** Action  : - read parameters 
     162      !! ** Purpose :   Initialisation of sea surface mean data      
    168163      !!---------------------------------------------------------------------- 
    169164      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code 
    … …  
    175170      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_3d       ! array of namelist information on the fields to read 
    176171      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_2d       ! array of namelist information on the fields to read 
    177       TYPE(FLD_N) :: sn_tem, sn_sal                     ! information about the fields to be read 
    178       TYPE(FLD_N) :: sn_usp, sn_vsp 
    179       TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 
    180       ! 
    181       NAMELIST/namsbc_sas/l_sasread, cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 
    182       !!---------------------------------------------------------------------- 
    183  
    184       IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN 
    185        
     172      TYPE(FLD_N) ::   sn_tem, sn_sal                     ! information about the fields to be read 
     173      TYPE(FLD_N) ::   sn_usp, sn_vsp 
     174      TYPE(FLD_N) ::   sn_ssh, sn_e3t, sn_frq 
     175      !! 
     176      NAMELIST/namsbc_sas/ l_sasread, cn_dir, ln_3d_uve, ln_read_frq,   & 
     177         &                 sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 
     178      !!---------------------------------------------------------------------- 
     179      ! 
     180      IF( ln_rstart .AND. nn_components == jp_iam_sas )   RETURN 
     181      ! 
     182      IF(lwp) THEN 
     183         WRITE(numout,*) 
     184         WRITE(numout,*) 'sbc_ssm_init : sea surface mean data initialisation ' 
     185         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     186      ENDIF 
     187      ! 
    186188      REWIND( numnam_ref )              ! Namelist namsbc_sas in reference namelist : Input fields 
    187189      READ  ( numnam_ref, namsbc_sas, IOSTAT = ios, ERR = 901) 
    188 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_sas in reference namelist', lwp ) 
    189  
     190901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_sas in reference namelist', lwp ) 
    190191      REWIND( numnam_cfg )              ! Namelist namsbc_sas in configuration namelist : Input fields 
    191192      READ  ( numnam_cfg, namsbc_sas, IOSTAT = ios, ERR = 902 ) 
    192 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist', lwp ) 
     193902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist', lwp ) 
    193194      IF(lwm) WRITE ( numond, namsbc_sas ) 
    194  
    195       !                                         ! store namelist information in an array 
    196       !                                         ! Control print 
    197       IF(lwp) THEN 
    198          WRITE(numout,*) 
    199          WRITE(numout,*) 'sbc_sas : standalone surface scheme ' 
    200          WRITE(numout,*) '~~~~~~~~~~~ ' 
     195      !            
     196      IF(lwp) THEN                              ! Control print 
    201197         WRITE(numout,*) '   Namelist namsbc_sas' 
    202          WRITE(numout,*) '      Initialisation using an input file  = ',l_sasread  
     198         WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread  
    203199         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve 
    204200         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq 
    205          WRITE(numout,*) 
    206201      ENDIF 
    207202      ! 
    … …  
    210205      ! 
    211206      IF( ln_apr_dyn ) THEN 
    212          IF( lwp ) WRITE(numout,*) 'No atmospheric gradient needed with StandAlone Surface scheme' 
     207         IF( lwp ) WRITE(numout,*) '         ==>>>   No atmospheric gradient needed with StandAlone Surface scheme' 
    213208         ln_apr_dyn = .FALSE. 
    214209      ENDIF 
    215210      IF( ln_rnf ) THEN 
    216          IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme' 
     211         IF( lwp ) WRITE(numout,*) '         ==>>>   No runoff needed with StandAlone Surface scheme' 
    217212         ln_rnf = .FALSE. 
    218213      ENDIF 
    219214      IF( ln_ssr ) THEN 
    220          IF( lwp ) WRITE(numout,*) 'No surface relaxation needed with StandAlone Surface scheme' 
     215         IF( lwp ) WRITE(numout,*) '         ==>>>   No surface relaxation needed with StandAlone Surface scheme' 
    221216         ln_ssr = .FALSE. 
    222217      ENDIF 
    223218      IF( nn_fwb > 0 ) THEN 
    224          IF( lwp ) WRITE(numout,*) 'No freshwater budget adjustment needed with StandAlone Surface scheme' 
     219         IF( lwp ) WRITE(numout,*) '         ==>>>   No freshwater budget adjustment needed with StandAlone Surface scheme' 
    225220         nn_fwb = 0 
    226221      ENDIF 
    227222      IF( ln_closea ) THEN 
    228          IF( lwp ) WRITE(numout,*) 'No closed seas adjustment needed with StandAlone Surface scheme' 
     223         IF( lwp ) WRITE(numout,*) '         ==>>>   No closed seas adjustment needed with StandAlone Surface scheme' 
    229224         ln_closea = .false. 
    230225      ENDIF 
    231       IF (l_sasread) THEN 
    232       !  
    233       !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 
    234       !! when we have other 3d arrays that we need to read in 
    235       !! so if a new field is added i.e. jf_new, just give it the next integer in sequence 
    236       !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d, 
    237       !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 
    238       !! and the rest of the logic should still work 
    239       ! 
    240       jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4   ! default 2D fields index 
    241       ! 
    242       IF( ln_3d_uve ) THEN 
    243          jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3      ! define 3D fields index 
    244          nfld_3d  = 2 + COUNT( (/.NOT.ln_linssh/) )        ! number of 3D fields to read 
    245          nfld_2d  = 3 + COUNT( (/ln_read_frq/) )   ! number of 2D fields to read 
    246       ELSE 
    247          jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/.NOT.ln_linssh/) )   ! update 2D fields index 
    248          nfld_3d  = 0                                                              ! no 3D fields to read 
    249          nfld_2d  = 5 + COUNT( (/.NOT.ln_linssh/) ) + COUNT( (/ln_read_frq/) )             ! number of 2D fields to read 
    250       ENDIF 
    251  
    252       IF( nfld_3d > 0 ) THEN 
    253          ALLOCATE( slf_3d(nfld_3d), STAT=ierr )         ! set slf structure 
    254          IF( ierr > 0 ) THEN 
    255             CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' )   ;   RETURN 
    256          ENDIF 
    257          slf_3d(jf_usp) = sn_usp 
    258          slf_3d(jf_vsp) = sn_vsp 
    259          IF( .NOT.ln_linssh )   slf_3d(jf_e3t) = sn_e3t 
    260       ENDIF 
    261  
    262       IF( nfld_2d > 0 ) THEN 
    263          ALLOCATE( slf_2d(nfld_2d), STAT=ierr )         ! set slf structure 
    264          IF( ierr > 0 ) THEN 
    265             CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 2d structure' )   ;   RETURN 
    266          ENDIF 
    267          slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 
    268          IF( ln_read_frq )   slf_2d(jf_frq) = sn_frq 
    269          IF( .NOT. ln_3d_uve ) THEN 
    270             slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 
    271             IF( .NOT.ln_linssh )   slf_2d(jf_e3t) = sn_e3t 
    272          ENDIF 
    273       ENDIF 
    274       ! 
    275       ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false.  
    276       IF( nfld_3d > 0 ) THEN 
    277          ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure 
    278          IF( ierr > 0 ) THEN 
    279             CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf structure' )   ;   RETURN 
    280          ENDIF 
    281          DO ifpr = 1, nfld_3d 
    282                                        ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 ) 
    283             IF( slf_3d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2)  , STAT=ierr1 ) 
    284             IF( ierr0 + ierr1 > 0 ) THEN 
    285                CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_3d array structure' )   ;   RETURN 
    286             ENDIF 
    287          END DO 
    288          !                                         ! fill sf with slf_i and control print 
    289          CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' ) 
    290       ENDIF 
    291  
    292       IF( nfld_2d > 0 ) THEN 
    293          ALLOCATE( sf_ssm_2d(nfld_2d), STAT=ierr )         ! set sf structure 
    294          IF( ierr > 0 ) THEN 
    295             CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf 2d structure' )   ;   RETURN 
    296          ENDIF 
    297          DO ifpr = 1, nfld_2d 
    298                                        ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 ) 
    299             IF( slf_2d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 ) 
    300             IF( ierr0 + ierr1 > 0 ) THEN 
    301                CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_2d array structure' )   ;   RETURN 
    302             ENDIF 
    303          END DO 
    304          ! 
    305          CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' ) 
    306       ENDIF 
    307       ! 
    308       ! finally tidy up 
    309  
    310       IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr ) 
    311       IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 
    312  
    313    ENDIF 
    314   
     226       
     227      !                   
     228      IF( l_sasread ) THEN                       ! store namelist information in an array 
     229         !  
     230         !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 
     231         !! when we have other 3d arrays that we need to read in 
     232         !! so if a new field is added i.e. jf_new, just give it the next integer in sequence 
     233         !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d, 
     234         !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 
     235         !! and the rest of the logic should still work 
     236         ! 
     237         jf_tem = 1   ;   jf_ssh = 3   ! default 2D fields index 
     238         jf_sal = 2   ;   jf_frq = 4   ! 
     239         ! 
     240         IF( ln_3d_uve ) THEN 
     241            jf_usp = 1   ;   jf_vsp = 2   ;   jf_e3t = 3     ! define 3D fields index 
     242            nfld_3d  = 2 + COUNT( (/.NOT.ln_linssh/) )       ! number of 3D fields to read 
     243            nfld_2d  = 3 + COUNT( (   /ln_read_frq/) )       ! number of 2D fields to read 
     244         ELSE 
     245            jf_usp = 4   ;   jf_e3t = 6                      ! update 2D fields index 
     246            jf_vsp = 5   ;   jf_frq = 6 + COUNT( (/.NOT.ln_linssh/) ) 
     247            ! 
     248            nfld_3d  = 0                                     ! no 3D fields to read 
     249            nfld_2d  = 5 + COUNT( (/.NOT.ln_linssh/) ) + COUNT( (/ln_read_frq/) )    ! number of 2D fields to read 
     250         ENDIF 
     251         ! 
     252         IF( nfld_3d > 0 ) THEN 
     253            ALLOCATE( slf_3d(nfld_3d), STAT=ierr )         ! set slf structure 
     254            IF( ierr > 0 ) THEN 
     255               CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' )   ;   RETURN 
     256            ENDIF 
     257            slf_3d(jf_usp) = sn_usp 
     258            slf_3d(jf_vsp) = sn_vsp 
     259            IF( .NOT.ln_linssh )   slf_3d(jf_e3t) = sn_e3t 
     260         ENDIF 
     261         ! 
     262         IF( nfld_2d > 0 ) THEN 
     263            ALLOCATE( slf_2d(nfld_2d), STAT=ierr )         ! set slf structure 
     264            IF( ierr > 0 ) THEN 
     265               CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 2d structure' )   ;   RETURN 
     266            ENDIF 
     267            slf_2d(jf_tem) = sn_tem   ;   slf_2d(jf_sal) = sn_sal   ;   slf_2d(jf_ssh) = sn_ssh 
     268            IF( ln_read_frq )   slf_2d(jf_frq) = sn_frq 
     269            IF( .NOT. ln_3d_uve ) THEN 
     270               slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 
     271               IF( .NOT.ln_linssh )   slf_2d(jf_e3t) = sn_e3t 
     272            ENDIF 
     273         ENDIF 
     274         ! 
     275         ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false.  
     276         IF( nfld_3d > 0 ) THEN 
     277            ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure 
     278            IF( ierr > 0 ) THEN 
     279               CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf structure' )   ;   RETURN 
     280            ENDIF 
     281            DO ifpr = 1, nfld_3d 
     282                                            ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 ) 
     283               IF( slf_3d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2)  , STAT=ierr1 ) 
     284               IF( ierr0 + ierr1 > 0 ) THEN 
     285                  CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_3d array structure' )   ;   RETURN 
     286               ENDIF 
     287            END DO 
     288            !                                         ! fill sf with slf_i and control print 
     289            CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' ) 
     290         ENDIF 
     291         ! 
     292         IF( nfld_2d > 0 ) THEN 
     293            ALLOCATE( sf_ssm_2d(nfld_2d), STAT=ierr )         ! set sf structure 
     294            IF( ierr > 0 ) THEN 
     295               CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf 2d structure' )   ;   RETURN 
     296            ENDIF 
     297            DO ifpr = 1, nfld_2d 
     298                                            ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 ) 
     299               IF( slf_2d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 ) 
     300               IF( ierr0 + ierr1 > 0 ) THEN 
     301                  CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_2d array structure' )   ;   RETURN 
     302               ENDIF 
     303            END DO 
     304            ! 
     305            CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' ) 
     306         ENDIF 
     307         ! 
     308         IF( nfld_3d > 0 )   DEALLOCATE( slf_3d, STAT=ierr ) 
     309         IF( nfld_2d > 0 )   DEALLOCATE( slf_2d, STAT=ierr ) 
     310         ! 
     311      ENDIF 
     312      ! 
    315313      CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in iceistate 
    316314      l_initdone = .TRUE. 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/AGE/trcnam_age.F90

    r9119 r9169  
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  
    77   !!---------------------------------------------------------------------- 
    8    !! trc_nam_age      : AGE  tracer initialisation 
     8   !! trc_nam_age      : AGE tracer initialisation 
    99   !!---------------------------------------------------------------------- 
    1010   USE oce_trc         ! Ocean variables 
    … …  
    2222   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2323   !!---------------------------------------------------------------------- 
    24  
    2524CONTAINS 
    2625 
    … …  
    3332      !! ** input   :   Namelist namage 
    3433      !!---------------------------------------------------------------------- 
    35       INTEGER :: ios                 ! Local integer output status for namelist read 
     34      INTEGER ::   ios   ! Local integer 
    3635      !! 
    3736      NAMELIST/namage/ rn_age_depth, rn_age_kill_rate  
    3837      !!---------------------------------------------------------------------- 
     38      ! 
     39      IF(lwp) THEN 
     40         WRITE(numout,*) 
     41         WRITE(numout,*) ' Sea Age Tracer' 
     42         WRITE(numout,*) 
     43         WRITE(numout,*) 'trc_nam_age : Read namage namelist for Age passive tracer' 
     44         WRITE(numout,*) '~~~~~~~~~~~' 
     45      ENDIF 
     46 
    3947      ! Variable setting 
    4048      ctrcnm    (jp_age) = 'Age' 
    … …  
    4856      REWIND( numnat_ref )              ! Namelist namagedate in reference namelist : AGE parameters 
    4957      READ  ( numnat_ref, namage, IOSTAT = ios, ERR = 901) 
    50 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namage in reference namelist', lwp ) 
    51  
     58901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namage in reference namelist', lwp ) 
    5259      REWIND( numnat_cfg )              ! Namelist namagedate in configuration namelist : AGE parameters 
    5360      READ  ( numnat_cfg, namage, IOSTAT = ios, ERR = 902 ) 
    54 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namage in configuration namelist', lwp ) 
     61902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namage in configuration namelist', lwp ) 
    5562      IF(lwm) WRITE ( numont, namage ) 
    56  
     63      ! 
    5764      IF(lwp) THEN                  ! control print 
    58          WRITE(numout,*) ' ' 
    59          WRITE(numout,*) ' Sea Age Tracer' 
    60          WRITE(numout,*) 
    61          WRITE(numout,*) ' trc_nam_age: Read namage, namelist for Age passive tracer' 
    62          WRITE(numout,*) ' ~~~~~~~' 
    63          WRITE(numout,*) '  depth over which age tracer reset to zero                              rn_age_depth      = ', & 
    64               &          rn_age_depth  
    65          WRITE(numout,*) '  recip of relax. timescale (s) for age tracer shallower than age_depth  rn_age_kill_rate  = ', & 
    66               &          rn_age_kill_rate  
    67          WRITE(numout,*) '' 
     65         WRITE(numout,*) '   Namelist : namage' 
     66         WRITE(numout,*) '      depth over which age tracer reset to zero     rn_age_depth      = ', rn_age_depth  
     67         WRITE(numout,*) '      recip of relaxation timescale                 rn_age_kill_rate  = ', rn_age_kill_rate, '[s]' 
     68         WRITE(numout,*) '      (for age tracer shallower than age_depth) ' 
    6869      ENDIF 
    69  
    7070      ! 
    7171   END SUBROUTINE trc_nam_age 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/C14/trcnam_c14.F90

    r7124 r9169  
    3737      !! ** input   :   Namelist namelist_c14 
    3838      !!---------------------------------------------------------------------- 
    39       INTEGER :: ios                 ! Local integer output status for namelist read 
     39      INTEGER ::   ios   ! Local integer 
    4040      !!  
    4141      NAMELIST/namc14_typ/ kc14typ,rc14at, pco2at, rc14init   ! type of C14 tracer, default values of C14/C, pco2, & ocean r14 
    4242      NAMELIST/namc14_sbc/ ln_chemh, xkwind, xdicsur          ! chem enh, wind coeff, ref DIC  
    43       NAMELIST/namc14_fcg/ cfileco2, cfilec14, tyrc14_beg  ! for transient exps; atm forcing 
     43      NAMELIST/namc14_fcg/ cfileco2, cfilec14, tyrc14_beg     ! for transient exps; atm forcing 
    4444      !!------------------------------------------------------------------- 
     45      ! 
     46      IF(lwp) THEN 
     47         WRITE(numout,*) ' ' 
     48         WRITE(numout,*) ' Radiocarbon C14' 
     49         WRITE(numout,*) ' ' 
     50         WRITE(numout,*) ' trc_nam_c14 : Read C14 namelists' 
     51         WRITE(numout,*) ' ~~~~~~~~~~~' 
     52      ENDIF 
     53      ! 
    4554      ! Variable setting 
    4655      ctrcnm    (jp_c14) = 'RC14' 
    … …  
    5463      REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist : 
    5564      READ  ( numtrc_ref, namc14_typ, IOSTAT = ios, ERR = 901) 
    56 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_typ in reference namelist', lwp ) 
    57  
     65901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_typ in reference namelist', lwp ) 
    5866      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist  
    5967      READ  ( numtrc_cfg, namc14_typ, IOSTAT = ios, ERR = 902) 
    60 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_typ in configuration namelist', lwp ) 
     68902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namc14_typ in configuration namelist', lwp ) 
    6169      IF(lwm) WRITE ( numonr, namc14_typ ) 
    62  
     70      ! 
    6371      IF(lwp) THEN                  ! control print 
    64          WRITE(numout,*) ' ' 
    65          WRITE(numout,*) ' Radiocarbon C14' 
    66          WRITE(numout,*) ' ' 
    67          WRITE(numout,*) ' Namelist namc14_typ' 
     72         WRITE(numout,*) '   Namelist : namc14_typ' 
     73         WRITE(numout,*) '      Type of C14 tracer (0=equilibrium; 1=bomb transient; 2=past transient) kc14typ = ', kc14typ 
     74         WRITE(numout,*) '      Default value for atmospheric C14/C (used for equil run)               rc14at  = ', rc14at 
     75         WRITE(numout,*) '      Default value for atmospheric pcO2 [atm] (used for equil run)          pco2at  = ', pco2at 
     76         WRITE(numout,*) '      Default value for initial C14/C in the ocean (used for equil run)      rc14init= ', rc14init 
    6877         WRITE(numout,*) 
    69          WRITE(numout,*) ' Type of C14 tracer (0=equilibrium; 1=bomb transient; 2=past transient) kc14typ = ', kc14typ 
    70          WRITE(numout,*) ' Default value for atmospheric C14/C (used for equil run)               rc14at  = ', rc14at 
    71          WRITE(numout,*) ' Default value for atmospheric pcO2 [atm] (used for equil run)          pco2at  = ', pco2at 
    72          WRITE(numout,*) ' Default value for initial C14/C in the ocean (used for equil run)      rc14init= ', rc14init 
    73          WRITE(numout,*) '  ' 
    7478      ENDIF 
    7579 
    7680      REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist : 
    7781      READ  ( numtrc_ref, namc14_sbc, IOSTAT = ios, ERR = 903) 
    78 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_sbc in reference namelist', lwp ) 
    79  
     82903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_sbc in reference namelist', lwp ) 
    8083      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist  
    8184      READ  ( numtrc_cfg, namc14_sbc, IOSTAT = ios, ERR = 904) 
    82 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_sbc in configuration namelist', lwp ) 
    83       IF(lwm) WRITE ( numonr, namc14_sbc ) 
    84  
     85904   IF( ios >  0 )  CALL ctl_nam ( ios , 'namc14_sbc in configuration namelist', lwp ) 
     86      IF(lwm) WRITE( numonr, namc14_sbc ) 
     87      ! 
    8588      IF(lwp) THEN                  ! control print 
    86          WRITE(numout,*) ' Namelist namc14_sbc' 
     89         WRITE(numout,*) '   Namelist namc14_sbc' 
     90         WRITE(numout,*) '      Chemical enhancement in piston velocity   ln_chemh = ', ln_chemh 
     91         WRITE(numout,*) '      Coefficient for gas exchange velocity     xkwind   = ', xkwind 
     92         WRITE(numout,*) '      Reference DIC concentration (mol/m3)      xdicsur  = ', xdicsur 
    8793         WRITE(numout,*) 
    88          WRITE(numout,*) ' Chemical enhancement in piston velocity   ln_chemh = ', ln_chemh 
    89          WRITE(numout,*) ' Coefficient for gas exchange velocity     xkwind   = ', xkwind 
    90          WRITE(numout,*) ' Reference DIC concentration (mol/m3)      xdicsur  = ', xdicsur 
    91          WRITE(numout,*) '  ' 
    9294      ENDIF 
    9395 
    9496      REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist : 
    9597      READ  ( numtrc_ref, namc14_fcg, IOSTAT = ios, ERR = 905) 
    96 905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_fcg in reference namelist', lwp ) 
    97  
     98905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_fcg in reference namelist', lwp ) 
    9899      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist  
    99100      READ  ( numtrc_cfg, namc14_fcg, IOSTAT = ios, ERR = 906) 
    100 906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_fcg in configuration namelist', lwp ) 
     101906   IF( ios >  0 )  CALL ctl_nam ( ios , 'namc14_fcg in configuration namelist', lwp ) 
    101102      IF(lwm) WRITE ( numonr, namc14_fcg ) 
    102  
     103      ! 
    103104      IF(lwp) THEN                  ! control print 
    104          WRITE(numout,*) ' Namelist namc14_fcg' 
    105          WRITE(numout,*) 
    106          WRITE(numout,*) ' Atmospheric co2 file ( bomb )  cfileco2   = ', TRIM( cfileco2 ) 
    107          WRITE(numout,*) ' Atmospheric c14 file ( bomb )  cfilec14   = ', TRIM( cfilec14 ) 
    108          WRITE(numout,*) ' Starting year of experiment    tyrc14_beg = ', tyrc14_beg 
    109          WRITE(numout,*) '  ' 
     105         WRITE(numout,*) '   Namelist namc14_fcg' 
     106         WRITE(numout,*) '      Atmospheric co2 file ( bomb )           cfileco2   = ', TRIM( cfileco2 ) 
     107         WRITE(numout,*) '      Atmospheric c14 file ( bomb )           cfilec14   = ', TRIM( cfilec14 ) 
     108         WRITE(numout,*) '      Starting year of experiment             tyrc14_beg = ', tyrc14_beg 
    110109      ENDIF 
    111110 
    112111      ! 
    113       IF( kc14typ == 2)    tyrc14_beg = 1950._wp - tyrc14_beg  ! BP to AD dates 
     112      IF( kc14typ == 2 )    tyrc14_beg = 1950._wp - tyrc14_beg   ! BP to AD dates 
    114113      ! set units  
    115114      rlam14 = LOG(2._wp) / 5730._wp / rsiyea    ! C14 decay  rate: yr^-1 --> s^-1 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90

    r7646 r9169  
    2424   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2525   !!---------------------------------------------------------------------- 
    26  
    2726CONTAINS 
    2827 
    … …  
    3837      !! ** input   :   Namelist namcfc 
    3938      !!---------------------------------------------------------------------- 
    40       INTEGER :: ios                 ! Local integer output status for namelist read 
    41       INTEGER :: jl, jn 
     39      INTEGER ::   ios   ! Local integer 
     40      INTEGER ::   jl, jn 
    4241      !! 
    4342      NAMELIST/namcfc/ ndate_beg, nyear_res, clname 
    4443      !!---------------------------------------------------------------------- 
     44      ! 
     45      IF(lwp) THEN 
     46         WRITE(numout,*) ' ' 
     47         WRITE(numout,*) ' CFCs' 
     48         WRITE(numout,*) ' ' 
     49         WRITE(numout,*) ' trc_nam_cfc : Read namcfc namelist for CFC chemical model' 
     50         WRITE(numout,*) ' ~~~~~~~~~~~' 
     51      ENDIF 
     52      ! 
     53      REWIND( numtrc_ref )              ! Namelist namcfcdate in reference namelist : CFC parameters 
     54      READ  ( numtrc_ref, namcfc, IOSTAT = ios, ERR = 901) 
     55901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfc in reference namelist', lwp ) 
     56      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist : CFC parameters 
     57      READ  ( numtrc_cfg, namcfc, IOSTAT = ios, ERR = 902 ) 
     58902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfc in configuration namelist', lwp ) 
     59      IF(lwm) WRITE( numonr, namcfc ) 
     60      IF(lwm) CALL FLUSH ( numonr )     ! flush output namelist CFC 
     61 
     62      IF(lwp) THEN                  ! control print 
     63         WRITE(numout,*) '   Namelist : namcfc' 
     64         WRITE(numout,*) '      initial calendar date (aammjj) for CFC     ndate_beg = ', ndate_beg, '[yymmdd]' 
     65         WRITE(numout,*) '      restoring time constant (year)             nyear_res = ', nyear_res 
     66      ENDIF 
     67      nyear_beg = ndate_beg / 10000 
     68      IF(lwp) WRITE(numout,*) '      associated initial year (aa)               nyear_beg = ', nyear_beg, '[yy]' 
    4569      ! 
    4670      jn = jp_cfc0 - 1 
    … …  
    79103      ENDIF 
    80104      ! 
    81       REWIND( numtrc_ref )              ! Namelist namcfcdate in reference namelist : CFC parameters 
    82       READ  ( numtrc_ref, namcfc, IOSTAT = ios, ERR = 901) 
    83 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfc in reference namelist', lwp ) 
    84  
    85       REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist : CFC parameters 
    86       READ  ( numtrc_cfg, namcfc, IOSTAT = ios, ERR = 902 ) 
    87 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfc in configuration namelist', lwp ) 
    88       IF(lwm) WRITE ( numonr, namcfc ) 
    89  
    90       IF(lwp) THEN                  ! control print 
    91          WRITE(numout,*) ' ' 
    92          WRITE(numout,*) ' CFCs' 
    93          WRITE(numout,*) ' ' 
    94          WRITE(numout,*) ' trc_nam: Read namdates, namelist for CFC chemical model' 
    95          WRITE(numout,*) ' ~~~~~~~' 
    96          WRITE(numout,*) '    initial calendar date (aammjj) for CFC  ndate_beg = ', ndate_beg 
    97          WRITE(numout,*) '    restoring time constant (year)          nyear_res = ', nyear_res 
    98       ENDIF 
    99       nyear_beg = ndate_beg / 10000 
    100       IF(lwp) WRITE(numout,*) '    initial year (aa)                       nyear_beg = ', nyear_beg 
    101       ! 
    102       IF(lwm) CALL FLUSH ( numonr )     ! flush output namelist CFC 
    103  
    104105   END SUBROUTINE trc_nam_cfc 
    105106    

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

    r9125 r9169  
    1313   USE oce_trc         ! 
    1414   USE trc             !  
    15    USE sms_pisces 
    16    USE p2zopt 
     15   USE sms_pisces      ! 
     16   USE p2zopt          ! 
     17   USE trd_oce         ! 
     18   USE trdtrc          ! 
     19   ! 
    1720   USE lbclnk          !  
    1821   USE prtctl_trc      ! Print control for debbuging 
    19    USE trd_oce 
    20    USE trdtrc 
    21    USE iom 
     22   USE iom             ! 
    2223    
    2324   IMPLICIT NONE 
    … …  
    8384      !!         
    8485      !!--------------------------------------------------------------------- 
    85       !! 
    8686      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    87       !! 
     87      ! 
    8888      INTEGER  ::   ji, jj, jk, jl 
    8989      REAL(wp) ::   zdet, zzoo, zphy, zno3, znh4, zdom      ! now concentrations 
    … …  
    9696      REAL(wp) ::   znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju 
    9797      REAL(wp) ::   ze3t 
    98       REAL(wp), ALLOCATABLE,   DIMENSION(:,:,:) :: zw2d 
    99       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zw3d 
     98      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  zw2d 
     99      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zw3d 
    100100      CHARACTER (len=25) :: charout 
    101101      !!--------------------------------------------------------------------- 
    … …  
    103103      IF( ln_timing )   CALL timing_start('p2z_bio') 
    104104      ! 
    105       IF( lk_iomput ) ALLOCATE( zw2d(jpi,jpj,17), zw3d(jpi,jpj,jpk,3) ) 
     105      IF( lk_iomput )   ALLOCATE( zw2d(jpi,jpj,17), zw3d(jpi,jpj,jpk,3) ) 
    106106 
    107107      IF( kt == nittrc000 ) THEN 
    … …  
    113113      xksi(:,:) = 0.e0        ! zooplakton closure ( fbod) 
    114114      IF( lk_iomput ) THEN 
    115          zw2d  (:,:,:) = 0.e0 
    116          zw3d(:,:,:,:) = 0.e0 
     115         zw2d  (:,:,:) = 0._wp 
     116         zw3d(:,:,:,:) = 0._wp 
    117117      ENDIF 
    118118 
    … …  
    311311               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
    312312               ! 
    313                 IF( lk_iomput ) THEN 
    314                   ! convert fluxes in per day 
     313                IF( lk_iomput ) THEN                  ! convert fluxes in per day 
    315314                  ze3t = e3t_n(ji,jj,jk) * 86400._wp 
    316315                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
    … …  
    335334                  zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 
    336335                  zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 
    337                    ! 
    338                 ENDIF 
     336                  ! 
     337               ENDIF 
    339338            END DO 
    340339         END DO 
    341340      END DO 
    342  
     341      ! 
    343342      IF( lk_iomput ) THEN 
    344         CALL lbc_lnk( zw2d(:,:,:),'T', 1. ) 
    345         CALL lbc_lnk_multi( zw3d(:,:,:,1),'T', 1., zw3d(:,:,:,2),'T', 1., zw3d(:,:,:,3),'T', 1. ) 
    346         ! Save diagnostics 
    347         CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) 
    348         CALL iom_put( "TNH4PHY", zw2d(:,:,2) ) 
    349         CALL iom_put( "TPHYDOM", zw2d(:,:,3) ) 
    350         CALL iom_put( "TPHYNH4", zw2d(:,:,4) ) 
    351         CALL iom_put( "TPHYZOO", zw2d(:,:,5) ) 
    352         CALL iom_put( "TPHYDET", zw2d(:,:,6) ) 
    353         CALL iom_put( "TDETZOO", zw2d(:,:,7) ) 
    354         CALL iom_put( "TZOODET", zw2d(:,:,8) ) 
    355         CALL iom_put( "TZOOBOD", zw2d(:,:,9) ) 
    356         CALL iom_put( "TZOONH4", zw2d(:,:,10) ) 
    357         CALL iom_put( "TZOODOM", zw2d(:,:,11) ) 
    358         CALL iom_put( "TNH4NO3", zw2d(:,:,12) ) 
    359         CALL iom_put( "TDOMNH4", zw2d(:,:,13) ) 
    360         CALL iom_put( "TDETNH4", zw2d(:,:,14) ) 
    361         CALL iom_put( "TPHYTOT", zw2d(:,:,15) ) 
    362         CALL iom_put( "TZOOTOT", zw2d(:,:,16) ) 
     343         CALL lbc_lnk( zw2d(:,:,:),'T', 1. ) 
     344         CALL lbc_lnk_multi( zw3d(:,:,:,1),'T', 1., zw3d(:,:,:,2),'T', 1., zw3d(:,:,:,3),'T', 1. ) 
     345         ! Save diagnostics 
     346         CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) 
     347         CALL iom_put( "TNH4PHY", zw2d(:,:,2) ) 
     348         CALL iom_put( "TPHYDOM", zw2d(:,:,3) ) 
     349         CALL iom_put( "TPHYNH4", zw2d(:,:,4) ) 
     350         CALL iom_put( "TPHYZOO", zw2d(:,:,5) ) 
     351         CALL iom_put( "TPHYDET", zw2d(:,:,6) ) 
     352         CALL iom_put( "TDETZOO", zw2d(:,:,7) ) 
     353         CALL iom_put( "TZOODET", zw2d(:,:,8) ) 
     354         CALL iom_put( "TZOOBOD", zw2d(:,:,9) ) 
     355         CALL iom_put( "TZOONH4", zw2d(:,:,10) ) 
     356         CALL iom_put( "TZOODOM", zw2d(:,:,11) ) 
     357         CALL iom_put( "TNH4NO3", zw2d(:,:,12) ) 
     358         CALL iom_put( "TDOMNH4", zw2d(:,:,13) ) 
     359         CALL iom_put( "TDETNH4", zw2d(:,:,14) ) 
     360         CALL iom_put( "TPHYTOT", zw2d(:,:,15) ) 
     361         CALL iom_put( "TZOOTOT", zw2d(:,:,16) ) 
    363362         !  
    364         CALL iom_put( "FNO3PHY", zw3d(:,:,:,1) ) 
    365         CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) ) 
    366         CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) 
     363         CALL iom_put( "FNO3PHY", zw3d(:,:,:,1) ) 
     364         CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) ) 
     365         CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) 
    367366         ! 
    368367      ENDIF 
    … …  
    374373      ENDIF 
    375374      ! 
    376       IF( lk_iomput ) DEALLOCATE( zw2d, zw3d ) 
     375      IF( lk_iomput )   DEALLOCATE( zw2d, zw3d ) 
    377376      ! 
    378377      IF( ln_timing )  CALL timing_stop('p2z_bio') 
    … …  
    390389      !! 
    391390      !!---------------------------------------------------------------------- 
     391      INTEGER ::   ios   ! Local integer 
     392      !! 
    392393      NAMELIST/namlobphy/ tmumax, rgamma, fphylab, tmminp, aki 
    393394      NAMELIST/namlobnut/ akno3, aknh4, taunn, psinut 
    394395      NAMELIST/namlobzoo/ rppz, taus, aks, rpnaz, rdnaz, tauzn, fzoolab, fdbod, tmminz 
    395       NAMELIST/namlobdet/  taudn, fdetlab 
     396      NAMELIST/namlobdet/ taudn, fdetlab 
    396397      NAMELIST/namlobdom/ taudomn 
    397       INTEGER :: ios                 ! Local integer output status for namelist read 
    398398      !!---------------------------------------------------------------------- 
    399  
     399      ! 
     400      IF(lwp) WRITE(numout,*) 
     401      IF(lwp) WRITE(numout,*) ' p2z_bio_init : LOBSTER bio-model initialization' 
     402      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~' 
     403      ! 
    400404      REWIND( numnatp_ref )              ! Namelist namlobphy in reference namelist : Lobster biological parameters 
    401405      READ  ( numnatp_ref, namlobphy, IOSTAT = ios, ERR = 901) 
    402 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobphy in reference namelist', lwp ) 
    403  
     406901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobphy in reference namelist', lwp ) 
    404407      REWIND( numnatp_cfg )              ! Namelist namlobphy in configuration namelist : Lobster biological parameters 
    405408      READ  ( numnatp_cfg, namlobphy, IOSTAT = ios, ERR = 902 ) 
    406 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobphy in configuration namelist', lwp ) 
     409902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namlobphy in configuration namelist', lwp ) 
    407410      IF(lwm) WRITE ( numonp, namlobphy ) 
    408  
     411      ! 
    409412      IF(lwp) THEN 
    410           WRITE(numout,*) ' Namelist namlobphy' 
    411           WRITE(numout,*) '    phyto max growth rate                                tmumax    =', 86400 * tmumax, ' d' 
    412           WRITE(numout,*) '    phytoplankton exudation fraction                     rgamma    =', rgamma 
    413           WRITE(numout,*) '    NH4 fraction of phytoplankton exsudation             fphylab   =', fphylab 
    414           WRITE(numout,*) '    minimal phyto mortality rate                         tmminp    =', 86400 * tmminp 
    415           WRITE(numout,*) '    light hlaf saturation constant                       aki       =', aki 
    416           WRITE(numout,*) ' ' 
     413         WRITE(numout,*) '   Namelist namlobphy' 
     414         WRITE(numout,*) '      phyto max growth rate                                tmumax    =', 86400 * tmumax, ' d' 
     415         WRITE(numout,*) '      phytoplankton exudation fraction                     rgamma    =', rgamma 
     416         WRITE(numout,*) '      NH4 fraction of phytoplankton exsudation             fphylab   =', fphylab 
     417         WRITE(numout,*) '      minimal phyto mortality rate                         tmminp    =', 86400 * tmminp 
     418         WRITE(numout,*) '      light hlaf saturation constant                       aki       =', aki 
    417419      ENDIF 
    418420 
    419421      REWIND( numnatp_ref )              ! Namelist namlobnut in reference namelist : Lobster nutriments parameters 
    420422      READ  ( numnatp_ref, namlobnut, IOSTAT = ios, ERR = 903) 
    421 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobnut in reference namelist', lwp ) 
    422  
     423903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobnut in reference namelist', lwp ) 
    423424      REWIND( numnatp_cfg )              ! Namelist namlobnut in configuration namelist : Lobster nutriments parameters 
    424425      READ  ( numnatp_cfg, namlobnut, IOSTAT = ios, ERR = 904 ) 
    425 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobnut in configuration namelist', lwp ) 
     426904   IF( ios >  0 )  CALL ctl_nam ( ios , 'namlobnut in configuration namelist', lwp ) 
    426427      IF(lwm) WRITE ( numonp, namlobnut ) 
    427428 
    428429      IF(lwp) THEN 
    429           WRITE(numout,*) ' Namelist namlobnut' 
    430           WRITE(numout,*) '    half-saturation nutrient for no3 uptake              akno3     =', akno3 
    431           WRITE(numout,*) '    half-saturation nutrient for nh4 uptake              aknh4     =', aknh4 
    432           WRITE(numout,*) '    nitrification rate                                   taunn     =', taunn 
    433           WRITE(numout,*) '    inhibition of no3 uptake by nh4                      psinut    =', psinut 
    434           WRITE(numout,*) ' ' 
     430         WRITE(numout,*)  
     431         WRITE(numout,*) '   Namelist namlobnut' 
     432         WRITE(numout,*) '      half-saturation nutrient for no3 uptake              akno3     =', akno3 
     433         WRITE(numout,*) '      half-saturation nutrient for nh4 uptake              aknh4     =', aknh4 
     434         WRITE(numout,*) '      nitrification rate                                   taunn     =', taunn 
     435         WRITE(numout,*) '      inhibition of no3 uptake by nh4                      psinut    =', psinut 
    435436      ENDIF 
    436437 
    437438      REWIND( numnatp_ref )              ! Namelist namlobzoo in reference namelist : Lobster zooplankton parameters 
    438439      READ  ( numnatp_ref, namlobzoo, IOSTAT = ios, ERR = 905) 
    439 905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobzoo in reference namelist', lwp ) 
    440  
     440905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobzoo in reference namelist', lwp ) 
    441441      REWIND( numnatp_cfg )              ! Namelist namlobzoo in configuration namelist : Lobster zooplankton parameters 
    442442      READ  ( numnatp_cfg, namlobzoo, IOSTAT = ios, ERR = 906 ) 
    443 906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobzoo in configuration namelist', lwp ) 
     443906   IF( ios >  0 )  CALL ctl_nam ( ios , 'namlobzoo in configuration namelist', lwp ) 
    444444      IF(lwm) WRITE ( numonp, namlobzoo ) 
    445445 
    446446      IF(lwp) THEN 
    447           WRITE(numout,*) ' Namelist namlobzoo' 
    448           WRITE(numout,*) '    zoo preference for phyto                             rppz      =', rppz 
    449           WRITE(numout,*) '    maximal zoo grazing rate                             taus      =', 86400 * taus, ' d' 
    450           WRITE(numout,*) '    half saturation constant for zoo food                aks       =', aks 
    451           WRITE(numout,*) '    non-assimilated phyto by zoo                         rpnaz     =', rpnaz 
    452           WRITE(numout,*) '    non-assimilated detritus by zoo                      rdnaz     =', rdnaz 
    453           WRITE(numout,*) '    zoo specific excretion rate                          tauzn     =', 86400 * tauzn 
    454           WRITE(numout,*) '    minimal zoo mortality rate                           tmminz    =', 86400 * tmminz 
    455           WRITE(numout,*) '    NH4 fraction of zooplankton excretion                fzoolab   =', fzoolab 
    456           WRITE(numout,*) '    Zooplankton mortality fraction that goes to detritus fdbod     =', fdbod 
    457           WRITE(numout,*) ' ' 
     447         WRITE(numout,*)  
     448         WRITE(numout,*) '   Namelist namlobzoo' 
     449         WRITE(numout,*) '      zoo preference for phyto                             rppz      =', rppz 
     450         WRITE(numout,*) '      maximal zoo grazing rate                             taus      =', 86400 * taus, ' d' 
     451         WRITE(numout,*) '      half saturation constant for zoo food                aks       =', aks 
     452         WRITE(numout,*) '      non-assimilated phyto by zoo                         rpnaz     =', rpnaz 
     453         WRITE(numout,*) '      non-assimilated detritus by zoo                      rdnaz     =', rdnaz 
     454         WRITE(numout,*) '      zoo specific excretion rate                          tauzn     =', 86400 * tauzn 
     455         WRITE(numout,*) '      minimal zoo mortality rate                           tmminz    =', 86400 * tmminz 
     456         WRITE(numout,*) '      NH4 fraction of zooplankton excretion                fzoolab   =', fzoolab 
     457         WRITE(numout,*) '      Zooplankton mortality fraction that goes to detritus fdbod     =', fdbod 
    458458      ENDIF 
    459459 
    460460      REWIND( numnatp_ref )              ! Namelist namlobdet in reference namelist : Lobster detritus parameters 
    461461      READ  ( numnatp_ref, namlobdet, IOSTAT = ios, ERR = 907) 
    462 907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdet in reference namelist', lwp ) 
    463  
     462907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobdet in reference namelist', lwp ) 
    464463      REWIND( numnatp_cfg )              ! Namelist namlobdet in configuration namelist : Lobster detritus parameters 
    465464      READ  ( numnatp_cfg, namlobdet, IOSTAT = ios, ERR = 908 ) 
    466 908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdet in configuration namelist', lwp ) 
     465908   IF( ios >  0 )  CALL ctl_nam ( ios , 'namlobdet in configuration namelist', lwp ) 
    467466      IF(lwm) WRITE ( numonp, namlobdet ) 
    468467 
    469468      IF(lwp) THEN 
    470           WRITE(numout,*) ' Namelist namlobdet' 
    471           WRITE(numout,*) '    detrital breakdown rate                              taudn     =', 86400 * taudn , ' d' 
    472           WRITE(numout,*) '    NH4 fraction of detritus dissolution                 fdetlab   =', fdetlab 
    473           WRITE(numout,*) ' ' 
     469          WRITE(numout,*)  
     470          WRITE(numout,*) '   Namelist namlobdet' 
     471          WRITE(numout,*) '      detrital breakdown rate                              taudn     =', 86400 * taudn , ' d' 
     472          WRITE(numout,*) '      NH4 fraction of detritus dissolution                 fdetlab   =', fdetlab 
    474473      ENDIF 
    475474 
    476475      REWIND( numnatp_ref )              ! Namelist namlobdom in reference namelist : Lobster DOM breakdown rate 
    477476      READ  ( numnatp_ref, namlobdom, IOSTAT = ios, ERR = 909) 
    478 909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdom in reference namelist', lwp ) 
    479  
     477909   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobdom in reference namelist', lwp ) 
    480478      REWIND( numnatp_cfg )              ! Namelist namlobdom in configuration namelist : Lobster DOM breakdown rate 
    481479      READ  ( numnatp_cfg, namlobdom, IOSTAT = ios, ERR = 910 ) 
    482 910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdom in configuration namelist', lwp ) 
     480910   IF( ios >  0 )  CALL ctl_nam ( ios , 'namlobdom in configuration namelist', lwp ) 
    483481      IF(lwm) WRITE ( numonp, namlobdom ) 
    484482 
    485483      IF(lwp) THEN 
    486           WRITE(numout,*) ' Namelist namlobdom' 
    487           WRITE(numout,*) '    DOM breakdown rate                                 taudomn     =', 86400 * taudn , ' d' 
    488           WRITE(numout,*) ' ' 
     484          WRITE(numout,*)  
     485          WRITE(numout,*) '   Namelist namlobdom' 
     486          WRITE(numout,*) '      DOM breakdown rate                                 taudomn     =', 86400 * taudn , ' d' 
    489487      ENDIF 
    490488      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

    r9125 r9169  
    1111   !!---------------------------------------------------------------------- 
    1212   USE oce_trc         ! 
    13    USE trc 
    14    USE sms_pisces 
    15    USE lbclnk 
    16    USE trd_oce 
    17    USE trdtrc 
    18    USE iom 
     13   USE trd_oce         ! 
     14   USE trdtrc          ! 
     15   USE trc             ! 
     16   USE sms_pisces      ! 
     17   ! 
     18   USE lbclnk          ! 
     19   USE iom             ! 
    1920   USE prtctl_trc      ! Print control for debbuging 
    2021 
    … …  
    2627 
    2728   REAL(wp), PUBLIC ::   sedlam      !: time coefficient of POC remineralization in sediments 
    28    REAL(wp), PUBLIC ::   sedlostpoc  ! mass of POC lost in sediments  
    29    REAL(wp), PUBLIC ::   vsed        ! detritus sedimentation speed [m/s]  
    30    REAL(wp), PUBLIC ::   xhr         ! coeff for martin''s remineralisation profile 
     29   REAL(wp), PUBLIC ::   sedlostpoc  !: mass of POC lost in sediments  
     30   REAL(wp), PUBLIC ::   vsed        !: detritus sedimentation speed [m/s]  
     31   REAL(wp), PUBLIC ::   xhr         !: coeff for martin''s remineralisation profile 
    3132 
    3233   !!---------------------------------------------------------------------- 
    … …  
    126127      !! 
    127128      !!---------------------------------------------------------------------- 
     129      INTEGER ::   ios   ! Local integer 
     130      !! 
    128131      NAMELIST/namlobsed/ sedlam, sedlostpoc, vsed, xhr 
    129       INTEGER :: ios                 ! Local integer output status for namelist read 
    130  
     132      !!---------------------------------------------------------------------- 
     133      ! 
    131134      REWIND( numnatp_ref )              ! Namelist namlobsed in reference namelist : Lobster sediments 
    132135      READ  ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901) 
    133 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlosed in reference namelist', lwp ) 
    134  
     136901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlosed in reference namelist', lwp ) 
    135137      REWIND( numnatp_cfg )              ! Namelist namlobsed in configuration namelist : Lobster sediments 
    136138      READ  ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 ) 
    137 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobsed in configuration namelist', lwp ) 
     139902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namlobsed in configuration namelist', lwp ) 
    138140      IF(lwm) WRITE ( numonp, namlobsed ) 
    139  
     141      ! 
    140142      IF(lwp) THEN 
    141           WRITE(numout,*) ' Namelist namlobsed' 
    142           WRITE(numout,*) '    time coeff of POC in sediments                       sedlam    =', sedlam 
    143           WRITE(numout,*) '    Sediment geol loss for POC                           sedlostpoc=', sedlostpoc 
    144           WRITE(numout,*) '    detritus sedimentation speed                         vsed      =', 86400 * vsed  , ' d' 
    145           WRITE(numout,*) '    coeff for martin''s remineralistion                  xhr       =', xhr 
     143          WRITE(numout,*) '   Namelist namlobsed' 
     144          WRITE(numout,*) '      time coeff of POC in sediments                sedlam    =', sedlam 
     145          WRITE(numout,*) '      Sediment geol loss for POC                    sedlostpoc=', sedlostpoc 
     146          WRITE(numout,*) '      detritus sedimentation speed                  vsed      =', 86400 * vsed  , ' d' 
     147          WRITE(numout,*) '      coeff for martin''s remineralistion           xhr       =', xhr 
    146148          WRITE(numout,*) ' ' 
    147149      ENDIF 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90

    r9125 r9169  
    77   !!             3.6  !  2015-05  (O. Aumont) PISCES quota 
    88   !!---------------------------------------------------------------------- 
    9    !!   p4z_fechem       :  Compute remineralization/scavenging of iron 
    10    !!   p4z_fechem_init  :  Initialisation of parameters for remineralisation 
    11    !!   p4z_fechem_alloc :  Allocate remineralisation variables 
     9   !!   p4z_fechem       : Compute remineralization/scavenging of iron 
     10   !!   p4z_fechem_init  : Initialisation of parameters for remineralisation 
     11   !!   p4z_fechem_alloc : Allocate remineralisation variables 
    1212   !!---------------------------------------------------------------------- 
    13    USE oce_trc         !  shared variables between ocean and passive tracers 
    14    USE trc             !  passive tracers common variables  
    15    USE sms_pisces      !  PISCES Source Minus Sink variables 
    16    USE p4zche          !  chemical model 
    17    USE p4zsbc          !  Boundary conditions from sediments 
    18    USE prtctl_trc      !  print control for debugging 
    19    USE iom             !  I/O manager 
     13   USE oce_trc         ! shared variables between ocean and passive tracers 
     14   USE trc             ! passive tracers common variables  
     15   USE sms_pisces      ! PISCES Source Minus Sink variables 
     16   USE p4zche          ! chemical model 
     17   USE p4zsbc          ! Boundary conditions from sediments 
     18   USE prtctl_trc      ! print control for debugging 
     19   USE iom             ! I/O manager 
    2020 
    2121   IMPLICIT NONE 
    2222   PRIVATE 
    2323 
    24    PUBLIC   p4z_fechem      ! called in p4zbio.F90 
    25    PUBLIC   p4z_fechem_init ! called in trcsms_pisces.F90 
    26  
    27    !! * Shared module variables 
    28    LOGICAL          ::  ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker 
    29    LOGICAL          ::  ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker 
    30    LOGICAL          ::  ln_fecolloid !: boolean for variable colloidal fraction 
    31    REAL(wp), PUBLIC ::  xlam1        !: scavenging rate of Iron  
    32    REAL(wp), PUBLIC ::  xlamdust     !: scavenging rate of Iron by dust  
    33    REAL(wp), PUBLIC ::  ligand       !: ligand concentration in the ocean  
    34    REAL(wp), PUBLIC ::  kfep         !: rate constant for nanoparticle formation 
    35  
    36    REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 
     24   PUBLIC   p4z_fechem        ! called in p4zbio.F90 
     25   PUBLIC   p4z_fechem_init   ! called in trcsms_pisces.F90 
     26 
     27   LOGICAL          ::   ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker 
     28   LOGICAL          ::   ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker 
     29   LOGICAL          ::   ln_fecolloid !: boolean for variable colloidal fraction 
     30   REAL(wp), PUBLIC ::   xlam1        !: scavenging rate of Iron  
     31   REAL(wp), PUBLIC ::   xlamdust     !: scavenging rate of Iron by dust  
     32   REAL(wp), PUBLIC ::   ligand       !: ligand concentration in the ocean  
     33   REAL(wp), PUBLIC ::   kfep         !: rate constant for nanoparticle formation 
     34 
     35   REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth      !!gm  <<<== DOCTOR names SVP !!! 
    3736 
    3837   !!---------------------------------------------------------------------- 
    … …  
    5655      !!                    and one particulate form (ln_fechem) 
    5756      !!--------------------------------------------------------------------- 
    58       ! 
    59       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     57      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
    6058      ! 
    6159      INTEGER  ::   ji, jj, jk, jic, jn 
    … …  
    6765      REAL(wp) ::   zzFeL1, zzFeL2, zzFe2, zzFeP, zzFe3, zzstrn2 
    6866      REAL(wp) ::   zrum, zcodel, zargu, zlight 
    69       REAL(wp) :: zkox, zkph1, zkph2, zph, zionic, ztligand 
    70       REAL(wp) :: za, zb, zc, zkappa1, zkappa2, za0, za1, za2 
    71       REAL(wp) :: zxs, zfunc, zp, zq, zd, zr, zphi, zfff, zp3, zq2 
    72       REAL(wp) :: ztfe, zoxy, zhplus 
    73       REAL(wp) :: zaggliga, zaggligb 
    74       REAL(wp) :: dissol, zligco 
     67      REAL(wp) ::   zkox, zkph1, zkph2, zph, zionic, ztligand 
     68      REAL(wp) ::   za, zb, zc, zkappa1, zkappa2, za0, za1, za2 
     69      REAL(wp) ::   zxs, zfunc, zp, zq, zd, zr, zphi, zfff, zp3, zq2 
     70      REAL(wp) ::   ztfe, zoxy, zhplus 
     71      REAL(wp) ::   zaggliga, zaggligb 
     72      REAL(wp) ::   dissol, zligco 
    7573      CHARACTER (len=25) :: charout 
    76       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zTL1, zFe3, ztotlig, precip, zFeL1 
    77       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zFeL2, zTL2, zFe2, zFeP 
    78       REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zstrn, zstrn2 
     74      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zTL1, zFe3, ztotlig, precip, zFeL1 
     75      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zFeL2, zTL2, zFe2, zFeP 
     76      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) ::   zstrn, zstrn2 
    7977      !!--------------------------------------------------------------------- 
    8078      ! 
    … …  
    384382      NAMELIST/nampisfer/ ln_fechem, ln_ligvar, ln_fecolloid, xlam1, xlamdust, ligand, kfep  
    385383      !!---------------------------------------------------------------------- 
    386  
    387       REWIND( numnatp_ref )              ! Namelist nampisfer in reference namelist : Pisces iron chemistry 
     384      ! 
     385      IF(lwp) THEN 
     386         WRITE(numout,*) 
     387         WRITE(numout,*) 'p4z_rem_init : Initialization of iron chemistry parameters' 
     388         WRITE(numout,*) '~~~~~~~~~~~~' 
     389      ENDIF 
     390      ! 
     391      REWIND( numnatp_ref )            ! Namelist nampisfer in reference namelist : Pisces iron chemistry 
    388392      READ  ( numnatp_ref, nampisfer, IOSTAT = ios, ERR = 901) 
    389 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisfer in reference namelist', lwp ) 
    390  
    391       REWIND( numnatp_cfg )              ! Namelist nampisfer in configuration namelist : Pisces iron chemistry 
     393901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisfer in reference namelist', lwp ) 
     394      REWIND( numnatp_cfg )            ! Namelist nampisfer in configuration namelist : Pisces iron chemistry 
    392395      READ  ( numnatp_cfg, nampisfer, IOSTAT = ios, ERR = 902 ) 
    393 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampisfer in configuration namelist', lwp ) 
    394       IF(lwm) WRITE ( numonp, nampisfer ) 
    395  
    396       IF(lwp) THEN                         ! control print 
    397          WRITE(numout,*) ' ' 
    398          WRITE(numout,*) ' Namelist parameters for Iron chemistry, nampisfer' 
    399          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    400          WRITE(numout,*) '    enable complex iron chemistry scheme      ln_fechem    =', ln_fechem 
    401          WRITE(numout,*) '    variable concentration of ligand          ln_ligvar    =', ln_ligvar 
    402          WRITE(numout,*) '    Variable colloidal fraction of Fe3+       ln_fecolloid =', ln_fecolloid 
    403          WRITE(numout,*) '    scavenging rate of Iron                   xlam1        =', xlam1 
    404          WRITE(numout,*) '    scavenging rate of Iron by dust           xlamdust     =', xlamdust 
    405          WRITE(numout,*) '    ligand concentration in the ocean         ligand       =', ligand 
    406          WRITE(numout,*) '    rate constant for nanoparticle formation  kfep         =', kfep 
    407       ENDIF 
    408       ! 
    409       IF( ln_fechem ) THEN 
    410          ! initialization of some constants used by the complexe chemistry scheme 
    411          ! ---------------------------------------------------------------------- 
     396902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisfer in configuration namelist', lwp ) 
     397      IF(lwm) WRITE( numonp, nampisfer ) 
     398 
     399      IF(lwp) THEN                     ! control print 
     400         WRITE(numout,*) '   Namelist : nampisfer' 
     401         WRITE(numout,*) '      enable complex iron chemistry scheme      ln_fechem    =', ln_fechem 
     402         WRITE(numout,*) '      variable concentration of ligand          ln_ligvar    =', ln_ligvar 
     403         WRITE(numout,*) '      Variable colloidal fraction of Fe3+       ln_fecolloid =', ln_fecolloid 
     404         WRITE(numout,*) '      scavenging rate of Iron                   xlam1        =', xlam1 
     405         WRITE(numout,*) '      scavenging rate of Iron by dust           xlamdust     =', xlamdust 
     406         WRITE(numout,*) '      ligand concentration in the ocean         ligand       =', ligand 
     407         WRITE(numout,*) '      rate constant for nanoparticle formation  kfep         =', kfep 
     408      ENDIF 
     409      ! 
     410      IF( ln_fechem ) THEN             ! set some constants used by the complexe chemistry scheme 
     411         ! 
    412412         spd = 3600. * 24. 
    413413         con = 1.E9 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    r9125 r9169  
    44   !! TOP :   PISCES CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
    55   !!====================================================================== 
    6    !! History :    -   !  1988-07  (E. MAIER-REIMER) Original code 
    7    !!              -   !  1998     (O. Aumont) additions 
    8    !!              -   !  1999     (C. Le Quere) modifications 
    9    !!             1.0  !  2004     (O. Aumont) modifications 
    10    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    11    !!                  !  2011-02  (J. Simeon, J. Orr) Include total atm P correction  
     6   !! History :   -   !  1988-07  (E. MAIER-REIMER) Original code 
     7   !!             -   !  1998     (O. Aumont) additions 
     8   !!             -   !  1999     (C. Le Quere) modifications 
     9   !!            1.0  !  2004     (O. Aumont) modifications 
     10   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     11   !!                 !  2011-02  (J. Simeon, J. Orr) Include total atm P correction  
    1212   !!---------------------------------------------------------------------- 
    1313   !!   p4z_flx       :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
    … …  
    1515   !!   p4z_patm      :   Read sfc atm pressure [atm] for each grid cell 
    1616   !!---------------------------------------------------------------------- 
    17    USE oce_trc                      !  shared variables between ocean and passive tracers  
    18    USE trc                          !  passive tracers common variables 
    19    USE sms_pisces                   !  PISCES Source Minus Sink variables 
    20    USE p4zche                       !  Chemical model 
    21    USE prtctl_trc                   !  print control for debugging 
    22    USE iom                          !  I/O manager 
    23    USE fldread                      !  read input fields 
     17   USE oce_trc        !  shared variables between ocean and passive tracers  
     18   USE trc            !  passive tracers common variables 
     19   USE sms_pisces     !  PISCES Source Minus Sink variables 
     20   USE p4zche         !  Chemical model 
     21   USE prtctl_trc     !  print control for debugging 
     22   USE iom            !  I/O manager 
     23   USE fldread        !  read input fields 
    2424 
    2525   IMPLICIT NONE 
    … …  
    3030   PUBLIC   p4z_flx_alloc   
    3131 
    32    !                               !!** Namelist  nampisext  ** 
    33    REAL(wp)          ::  atcco2     !: pre-industrial atmospheric [co2] (ppm)     
    34    LOGICAL           ::  ln_co2int  !: flag to read in a file and interpolate atmospheric pco2 or not 
    35    CHARACTER(len=34) ::  clname     !: filename of pco2 values 
    36    INTEGER           ::  nn_offset  !: Offset model-data start year (default = 0)  
     32   !                                 !!** Namelist  nampisext  ** 
     33   REAL(wp)          ::   atcco2      !: pre-industrial atmospheric [co2] (ppm)   
     34   LOGICAL           ::   ln_co2int   !: flag to read in a file and interpolate atmospheric pco2 or not 
     35   CHARACTER(len=34) ::   clname      !: filename of pco2 values 
     36   INTEGER           ::   nn_offset   !: Offset model-data start year (default = 0)  
    3737 
    3838   !!  Variables related to reading atmospheric CO2 time history     
    39    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: atcco2h, years 
    40    INTEGER  :: nmaxrec, numco2 
    41  
    42    !                               !!* nampisatm namelist (Atmospheric PRessure) * 
     39   INTEGER                                   ::   nmaxrec, numco2   ! 
     40   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   atcco2h, years    ! 
     41 
     42   !                                  !!* nampisatm namelist (Atmospheric PRessure) * 
    4343   LOGICAL, PUBLIC ::   ln_presatm     !: ref. pressure: global mean Patm (F) or a constant (F) 
    4444   LOGICAL, PUBLIC ::   ln_presatmco2  !: accounting for spatial atm CO2 in the compuation of carbon flux (T) or not (F) 
    4545 
    46    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) ::  patm      ! atmospheric pressure at kt                 [N/m2] 
    47    TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::  sf_patm   ! structure of input fields (file informations, fields read) 
    48    TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::  sf_atmco2 ! structure of input fields (file informations, fields read) 
    49  
    50    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2  
    51  
    52    REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion  
     46   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   patm      ! atmospheric pressure at kt                 [N/m2] 
     47   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::   sf_patm   ! structure of input fields (file informations, fields read) 
     48   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::   sf_atmco2 ! structure of input fields (file informations, fields read) 
     49 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  satmco2   !: atmospheric pco2  
     51 
     52   REAL(wp) ::   xconv  = 0.01_wp / 3600._wp  !: coefficients for conversion  
    5353 
    5454   !!---------------------------------------------------------------------- 
    … …  
    7070      !!              - Add option for time-interpolation of atcco2.txt   
    7171      !!--------------------------------------------------------------------- 
    72       ! 
    7372      INTEGER, INTENT(in) ::   kt, knt   ! 
    7473      ! 
    … …  
    7978      REAL(wp) ::   zph, zdic, zsch_o2, zsch_co2 
    8079      REAL(wp) ::   zyr_dec, zdco2dt 
    81       CHARACTER (len=25) :: charout 
    82       REAL(wp), DIMENSION(jpi,jpj) :: zkgco2, zkgo2, zh2co3, zoflx,  zpco2atm   
    83       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zw2d 
     80      CHARACTER (len=25) ::   charout 
     81      REAL(wp), DIMENSION(jpi,jpj) ::   zkgco2, zkgo2, zh2co3, zoflx,  zpco2atm   
     82      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zw2d 
    8483      !!--------------------------------------------------------------------- 
    8584      ! 
    8685      IF( ln_timing )   CALL timing_start('p4z_flx') 
    8786      ! 
    88  
    8987      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
    9088      !     SURFACE LAYER); THE RESULT OF THIS CALCULATION 
    9189      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2 
    9290 
    93       IF( kt /= nit000 .AND. .NOT.l_co2cpl .AND. knt == 1 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 
     91      IF( kt /= nit000 .AND. .NOT.l_co2cpl .AND. knt == 1 )   CALL p4z_patm( kt )   ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 
    9492 
    9593      IF( ln_co2int .AND. .NOT.ln_presatmco2 .AND. .NOT.l_co2cpl ) THEN  
    … …  
    226224      !! ** Method  :   Read the nampisext namelist and check the parameters 
    227225      !!      called at the first timestep (nittrc000) 
     226      !! 
    228227      !! ** input   :   Namelist nampisext 
    229228      !!---------------------------------------------------------------------- 
    230       INTEGER ::   jm 
    231       INTEGER ::   ios   ! Local integer  
    232       ! 
     229      INTEGER ::   jm, ios   ! Local integer  
     230      !! 
    233231      NAMELIST/nampisext/ln_co2int, atcco2, clname, nn_offset 
    234232      !!---------------------------------------------------------------------- 
    235       ! 
    236  
     233      IF(lwp) THEN 
     234         WRITE(numout,*) 
     235         WRITE(numout,*) ' p4z_flx_init : atmospheric conditions for air-sea flux calculation' 
     236         WRITE(numout,*) ' ~~~~~~~~~~~~' 
     237      ENDIF 
     238      ! 
    237239      REWIND( numnatp_ref )              ! Namelist nampisext in reference namelist : Pisces atm. conditions 
    238240      READ  ( numnatp_ref, nampisext, IOSTAT = ios, ERR = 901) 
    239 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisext in reference namelist', lwp ) 
    240  
     241901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisext in reference namelist', lwp ) 
    241242      REWIND( numnatp_cfg )              ! Namelist nampisext in configuration namelist : Pisces atm. conditions 
    242243      READ  ( numnatp_cfg, nampisext, IOSTAT = ios, ERR = 902 ) 
    243 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampisext in configuration namelist', lwp ) 
     244902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisext in configuration namelist', lwp ) 
    244245      IF(lwm) WRITE ( numonp, nampisext ) 
    245246      ! 
    246247      IF(lwp) THEN                         ! control print 
    247          WRITE(numout,*) ' ' 
    248          WRITE(numout,*) ' Namelist parameters for air-sea exchange, nampisext' 
    249          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    250          WRITE(numout,*) '    Choice for reading in the atm pCO2 file or constant value, ln_co2int =', ln_co2int 
    251          WRITE(numout,*) ' ' 
    252       ENDIF 
     248         WRITE(numout,*) '   Namelist : nampisext --- parameters for air-sea exchange' 
     249         WRITE(numout,*) '      reading in the atm pCO2 file or constant value   ln_co2int =', ln_co2int 
     250      ENDIF 
     251 
     252!!gm  BUG !!!   ===>>>  ln_presatm and ln_presatmco2 are used below, but read in namelist  
     253!!gm                    at the end of the routine via a CALL to CALL p4z_patm( nit000 ) 
     254 
    253255     IF( .NOT.ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 
    254256         IF(lwp) THEN                         ! control print 
    255             WRITE(numout,*) '    Constant Atmospheric pCO2 value  atcco2    =', atcco2 
    256             WRITE(numout,*) ' ' 
     257            WRITE(numout,*) '         Constant Atmospheric pCO2 value               atcco2    =', atcco2 
    257258         ENDIF 
    258259         satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
    259260      ELSEIF( ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 
    260261         IF(lwp)  THEN 
    261             WRITE(numout,*) '    Atmospheric pCO2 value  from file clname      =', TRIM( clname ) 
    262             WRITE(numout,*) '    Offset model-data start year      nn_offset   =', nn_offset 
    263             WRITE(numout,*) ' ' 
     262            WRITE(numout,*) '         Constant Atmospheric pCO2 value               atcco2    =', atcco2 
     263            WRITE(numout,*) '         Atmospheric pCO2 value  from file             clname    =', TRIM( clname ) 
     264            WRITE(numout,*) '         Offset model-data start year                  nn_offset =', nn_offset 
    264265         ENDIF 
    265266         CALL ctl_opn( numco2, TRIM( clname) , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1 , numout, lwp ) 
    … …  
    270271         END DO 
    271272 100     nmaxrec = jm - 1  
    272          ALLOCATE( years  (nmaxrec) )     ;      years  (:) = 0._wp 
    273          ALLOCATE( atcco2h(nmaxrec) )     ;      atcco2h(:) = 0._wp 
    274  
     273         ALLOCATE( years  (nmaxrec) )   ;   years  (:) = 0._wp 
     274         ALLOCATE( atcco2h(nmaxrec) )   ;   atcco2h(:) = 0._wp 
     275         ! 
    275276         REWIND(numco2) 
    276277         DO jm = 1, nmaxrec          ! get  xCO2 data 
    … …  
    282283         IF(lwp)  THEN 
    283284            WRITE(numout,*) '    Spatialized Atmospheric pCO2 from an external file' 
    284             WRITE(numout,*) ' ' 
    285285         ENDIF 
    286286      ELSE 
    287287         IF(lwp)  THEN 
    288288            WRITE(numout,*) '    Spatialized Atmospheric pCO2 from an external file' 
    289             WRITE(numout,*) ' ' 
    290289         ENDIF 
    291290      ENDIF 
    … …  
    304303      !!                  ***  ROUTINE p4z_atm  *** 
    305304      !! 
    306       !! ** Purpose :   Read and interpolate the external atmospheric sea-levl pressure 
     305      !! ** Purpose :   Read and interpolate the external atmospheric sea-level pressure 
    307306      !! ** Method  :   Read the files and interpolate the appropriate variables 
    308307      !! 
    309308      !!---------------------------------------------------------------------- 
    310       INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    311       ! 
    312       INTEGER            ::  ierr 
    313       INTEGER            ::  ios      ! Local integer output status for namelist read 
    314       CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files 
    315       TYPE(FLD_N)        ::  sn_patm  ! informations about the fields to be read 
    316       TYPE(FLD_N)        ::  sn_atmco2 ! informations about the fields to be read 
     309      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     310      ! 
     311      INTEGER            ::   ierr, ios   ! Local integer 
     312      CHARACTER(len=100) ::   cn_dir      ! Root directory for location of ssr files 
     313      TYPE(FLD_N)        ::   sn_patm     ! informations about the fields to be read 
     314      TYPE(FLD_N)        ::   sn_atmco2   ! informations about the fields to be read 
    317315      !! 
    318316      NAMELIST/nampisatm/ ln_presatm, ln_presatmco2, sn_patm, sn_atmco2, cn_dir 
    319317      !!---------------------------------------------------------------------- 
    320  
    321       !                                         ! ----------------------- ! 
    322       IF( kt == nit000 ) THEN                   ! First call kt=nittrc000 ! 
    323  
     318      ! 
     319      IF( kt == nit000 ) THEN    !==  First call kt=nittrc000  ==! 
     320         ! 
     321         IF(lwp) THEN 
     322            WRITE(numout,*) 
     323            WRITE(numout,*) ' p4z_patm : sea-level atmospheric pressure' 
     324            WRITE(numout,*) ' ~~~~~~~~' 
     325         ENDIF 
     326         ! 
    324327         REWIND( numnatp_ref )              ! Namelist nampisatm in reference namelist : Pisces atm. sea level pressure file 
    325328         READ  ( numnatp_ref, nampisatm, IOSTAT = ios, ERR = 901) 
    326329901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisatm in reference namelist', lwp ) 
    327  
    328330         REWIND( numnatp_cfg )              ! Namelist nampisatm in configuration namelist : Pisces atm. sea level pressure file  
    329331         READ  ( numnatp_cfg, nampisatm, IOSTAT = ios, ERR = 902 ) 
    330 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisatm in configuration namelist', lwp ) 
     332902      IF( ios >  0 )  CALL ctl_nam ( ios , 'nampisatm in configuration namelist', lwp ) 
    331333         IF(lwm) WRITE ( numonp, nampisatm ) 
    332334         ! 
    333335         ! 
    334336         IF(lwp) THEN                                 !* control print 
    335             WRITE(numout,*) 
    336             WRITE(numout,*) '   Namelist nampisatm : Atmospheric Pressure as external forcing' 
    337             WRITE(numout,*) '      constant atmopsheric pressure (F) or from a file (T)  ln_presatm = ', ln_presatm 
    338             WRITE(numout,*) '      spatial atmopsheric CO2 for flux calcs  ln_presatmco2 = ', ln_presatmco2 
    339             WRITE(numout,*) 
     337            WRITE(numout,*) '   Namelist : nampisatm --- Atmospheric Pressure as external forcing' 
     338            WRITE(numout,*) '      constant atmopsheric pressure (F) or from a file (T)  ln_presatm    = ', ln_presatm 
     339            WRITE(numout,*) '      spatial atmopsheric CO2 for flux calcs                ln_presatmco2 = ', ln_presatmco2 
    340340         ENDIF 
    341341         ! 
    … …  
    358358         ENDIF 
    359359         ! 
    360          IF( .NOT.ln_presatm )   patm(:,:) = 1.e0    ! Initialize patm if no reading from a file 
     360         IF( .NOT.ln_presatm )   patm(:,:) = 1._wp    ! Initialize patm if no reading from a file 
    361361         ! 
    362362      ENDIF 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zligand.F90

    r9124 r9169  
    66   !! History :   3.6  !  2016-03  (O. Aumont, A. Tagliabue) Quota model and reorganization 
    77   !!---------------------------------------------------------------------- 
    8    !!   p4z_ligand       :  Compute remineralization/dissolution of organic ligands 
    9    !!   p4z_ligand_init  :  Initialisation of parameters for remineralisation 
     8   !!   p4z_ligand     :  Compute remineralization/dissolution of organic ligands 
     9   !!   p4z_ligand_init:  Initialisation of parameters for remineralisation 
    1010   !!---------------------------------------------------------------------- 
    11    USE oce_trc         !  shared variables between ocean and passive tracers 
    12    USE trc             !  passive tracers common variables  
    13    USE sms_pisces      !  PISCES Source Minus Sink variables 
    14    USE prtctl_trc      !  print control for debugging 
     11   USE oce_trc         ! shared variables between ocean and passive tracers 
     12   USE trc             ! passive tracers common variables  
     13   USE sms_pisces      ! PISCES Source Minus Sink variables 
     14   USE prtctl_trc      ! print control for debugging 
    1515 
    1616   IMPLICIT NONE 
    … …  
    2020   PUBLIC   p4z_ligand_init    ! called in trcsms_pisces.F90 
    2121 
    22    !! * Shared module variables 
    2322   REAL(wp), PUBLIC ::  rlgw     !: lifetime (years) of weak ligands 
    2423   REAL(wp), PUBLIC ::  rlgs     !: lifetime (years) of strong ligands 
    … …  
    3938      !! 
    4039      !! ** Purpose :   Compute remineralization/scavenging of organic ligands 
    41       !! 
    42       !! ** Method  : - ??? 
    4340      !!--------------------------------------------------------------------- 
    44       ! 
    4541      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
    4642      ! 
    4743      INTEGER  ::   ji, jj, jk 
    4844      REAL(wp) ::   zlgwp, zlgwpr, zlgwr, zlablgw, zrfepa, zfepr 
    49       CHARACTER (len=25) :: charout 
     45      CHARACTER (len=25) ::   charout 
    5046      !!--------------------------------------------------------------------- 
    5147      ! 
    5248      IF( ln_timing )   CALL timing_start('p4z_ligand') 
    5349      ! 
    54       ! ------------------------------------------------------------------ 
    55       ! Remineralization of iron ligands 
    56       ! ------------------------------------------------------------------ 
    5750      DO jk = 1, jpkm1 
    5851         DO jj = 1, jpj 
    5952            DO ji = 1, jpi 
     53               ! 
     54               ! ------------------------------------------------------------------ 
     55               ! Remineralization of iron ligands 
     56               ! ------------------------------------------------------------------ 
    6057               ! production from remineralisation of organic matter 
    6158               zlgwp  = orem(ji,jj,jk) * rlig 
    … …  
    6865               zlgwpr = prlgw * xstep * etot(ji,jj,jk) * trb(ji,jj,jk,jplgw) * (1. - fr_i(ji,jj)) 
    6966               tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zlgwp - zlgwr - zlgwpr 
    70             END DO 
    71          END DO 
    72       END DO 
    73  
    74       ! ---------------------------------------------------------- 
    75       ! Dissolution of nanoparticle Fe 
    76       ! ---------------------------------------------------------- 
    77       DO jk = 1, jpkm1 
    78          DO jj = 1, jpj 
    79             DO ji = 1, jpi 
     67               ! 
     68               ! ---------------------------------------------------------- 
     69               ! Dissolution of nanoparticle Fe 
     70               ! ---------------------------------------------------------- 
    8071               ! dissolution rate is maximal in the presence of light and  
    8172               ! lower in the aphotici zone 
    … …  
    8677               tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) - zfepr 
    8778               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zfepr 
     79               ! 
    8880            END DO 
    8981         END DO 
    9082      END DO 
    91  
     83      ! 
    9284      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    9385         WRITE(charout, FMT="('ligand1')") 
    9486         CALL prt_ctl_trc_info(charout) 
    9587         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    96        ENDIF 
     88      ENDIF 
    9789      ! 
    9890      IF( ln_timing )   CALL timing_stop('p4z_ligand') 
    … …  
    108100      !! 
    109101      !! ** Method  :   Read the nampislig namelist and check the parameters 
    110       !!      called at the first timestep 
    111102      !! 
    112103      !! ** input   :   Namelist nampislig 
    113       !! 
    114104      !!---------------------------------------------------------------------- 
    115105      INTEGER ::   ios   ! Local integer  
    … …  
    117107      NAMELIST/nampislig/ rlgw, prlgw, rlgs, rfep, rlig 
    118108      !!---------------------------------------------------------------------- 
    119  
     109      ! 
     110      IF(lwp) THEN 
     111         WRITE(numout,*) 
     112         WRITE(numout,*) 'p4z_ligand_init : remineralization/scavenging of organic ligands' 
     113         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
     114      ENDIF 
    120115      REWIND( numnatp_ref )              ! Namelist nampislig in reference namelist : Pisces remineralization 
    121116      READ  ( numnatp_ref, nampislig, IOSTAT = ios, ERR = 901) 
    122 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislig in reference namelist', lwp ) 
    123  
     117901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampislig in reference namelist', lwp ) 
    124118      REWIND( numnatp_cfg )              ! Namelist nampislig in configuration namelist : Pisces remineralization 
    125119      READ  ( numnatp_cfg, nampislig, IOSTAT = ios, ERR = 902 ) 
    126 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislig in configuration namelist', lwp ) 
     120902   IF( ios >  0 )  CALL ctl_nam ( ios , 'nampislig in configuration namelist', lwp ) 
    127121      IF(lwm) WRITE ( numonp, nampislig ) 
    128  
     122      ! 
    129123      IF(lwp) THEN                         ! control print 
    130          WRITE(numout,*) ' ' 
    131          WRITE(numout,*) ' Namelist parameters for ligands, nampislig' 
    132          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    133          WRITE(numout,*) '    Dissolution rate of FeP                        rfep =', rfep 
    134          WRITE(numout,*) '    Lifetime (years) of weak ligands               rlgw =', rlgw 
    135          WRITE(numout,*) '    Remin ligand production per unit C             rlig =', rlig 
    136          WRITE(numout,*) '    Photolysis of weak ligand                     prlgw =', prlgw 
    137          WRITE(numout,*) '    Lifetime (years) of strong ligands             rlgs =', rlgs 
     124         WRITE(numout,*) '   Namelist : nampislig' 
     125         WRITE(numout,*) '      Dissolution rate of FeP                      rfep  =', rfep 
     126         WRITE(numout,*) '      Lifetime (years) of weak ligands             rlgw  =', rlgw 
     127         WRITE(numout,*) '      Remin ligand production per unit C           rlig  =', rlig 
     128         WRITE(numout,*) '      Photolysis of weak ligand                    prlgw =', prlgw 
     129         WRITE(numout,*) '      Lifetime (years) of strong ligands           rlgs  =', rlgs 
    138130      ENDIF 
    139131      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90

    r9124 r9169  
    215215      ! 
    216216      IF( lk_iomput .AND. knt == nrdttrc ) THEN        ! save output diagnostics 
    217         IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht 
    218         IF( iom_use( "LNnut"   ) ) CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
    219         IF( iom_use( "LDnut"   ) ) CALL iom_put( "LDnut"  , xlimdia(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
    220         IF( iom_use( "LNFe"    ) ) CALL iom_put( "LNFe"   , xlimnfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
    221         IF( iom_use( "LDFe"    ) ) CALL iom_put( "LDFe"   , xlimdfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
     217        IF( iom_use( "xfracal" ) )   CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht 
     218        IF( iom_use( "LNnut"   ) )   CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
     219        IF( iom_use( "LDnut"   ) )   CALL iom_put( "LDnut"  , xlimdia(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
     220        IF( iom_use( "LNFe"    ) )   CALL iom_put( "LNFe"   , xlimnfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
     221        IF( iom_use( "LDFe"    ) )   CALL iom_put( "LDFe"   , xlimdfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
    222222      ENDIF 
    223223      ! 
    … …  
    246246      !!---------------------------------------------------------------------- 
    247247      ! 
     248      IF(lwp) THEN 
     249         WRITE(numout,*) 
     250         WRITE(numout,*) 'p4z_lim_init : initialization of nutrient limitations' 
     251         WRITE(numout,*) '~~~~~~~~~~~~' 
     252      ENDIF 
     253      ! 
    248254      REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters 
    249255      READ  ( numnatp_ref, namp4zlim, IOSTAT = ios, ERR = 901) 
    250 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in reference namelist', lwp ) 
    251       ! 
     256901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zlim in reference namelist', lwp ) 
    252257      REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters  
    253258      READ  ( numnatp_cfg, namp4zlim, IOSTAT = ios, ERR = 902 ) 
    254 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp4zlim in configuration namelist', lwp ) 
    255       IF(lwm) WRITE ( numonp, namp4zlim ) 
     259902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zlim in configuration namelist', lwp ) 
     260      IF(lwm) WRITE( numonp, namp4zlim ) 
    256261      ! 
    257262      IF(lwp) THEN                         ! control print 
    258          WRITE(numout,*) ' ' 
    259          WRITE(numout,*) ' Namelist parameters for nutrient limitations, namp4zlim' 
    260          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    261          WRITE(numout,*) '    mean rainratio                           caco3r    = ', caco3r 
    262          WRITE(numout,*) '    NO3 half saturation of nanophyto         concnno3  = ', concnno3 
    263          WRITE(numout,*) '    NO3 half saturation of diatoms           concdno3  = ', concdno3 
    264          WRITE(numout,*) '    NH4 half saturation for phyto            concnnh4  = ', concnnh4 
    265          WRITE(numout,*) '    NH4 half saturation for diatoms          concdnh4  = ', concdnh4 
    266          WRITE(numout,*) '    half saturation constant for Si uptake   xksi1     = ', xksi1 
    267          WRITE(numout,*) '    half saturation constant for Si/C        xksi2     = ', xksi2 
    268          WRITE(numout,*) '    half-sat. of DOC remineralization        xkdoc     = ', xkdoc 
    269          WRITE(numout,*) '    Iron half saturation for nanophyto       concnfer  = ', concnfer 
    270          WRITE(numout,*) '    Iron half saturation for diatoms         concdfer  = ', concdfer 
    271          WRITE(numout,*) '    size ratio for nanophytoplankton         xsizern   = ', xsizern 
    272          WRITE(numout,*) '    size ratio for diatoms                   xsizerd   = ', xsizerd 
    273          WRITE(numout,*) '    NO3 half saturation of bacteria          concbno3  = ', concbno3 
    274          WRITE(numout,*) '    NH4 half saturation for bacteria         concbnh4  = ', concbnh4 
    275          WRITE(numout,*) '    Minimum size criteria for diatoms        xsizedia  = ', xsizedia 
    276          WRITE(numout,*) '    Minimum size criteria for nanophyto      xsizephy  = ', xsizephy 
    277          WRITE(numout,*) '    Fe half saturation for bacteria          concbfe   = ', concbfe 
    278          WRITE(numout,*) '    halk saturation constant for anoxia       oxymin   =' , oxymin 
    279          WRITE(numout,*) '    optimal Fe quota for nano.               qnfelim   = ', qnfelim 
    280          WRITE(numout,*) '    Optimal Fe quota for diatoms             qdfelim   = ', qdfelim 
     263         WRITE(numout,*) '   Namelist : namp4zlim' 
     264         WRITE(numout,*) '      mean rainratio                           caco3r    = ', caco3r 
     265         WRITE(numout,*) '      NO3 half saturation of nanophyto         concnno3  = ', concnno3 
     266         WRITE(numout,*) '      NO3 half saturation of diatoms           concdno3  = ', concdno3 
     267         WRITE(numout,*) '      NH4 half saturation for phyto            concnnh4  = ', concnnh4 
     268         WRITE(numout,*) '      NH4 half saturation for diatoms          concdnh4  = ', concdnh4 
     269         WRITE(numout,*) '      half saturation constant for Si uptake   xksi1     = ', xksi1 
     270         WRITE(numout,*) '      half saturation constant for Si/C        xksi2     = ', xksi2 
     271         WRITE(numout,*) '      half-sat. of DOC remineralization        xkdoc     = ', xkdoc 
     272         WRITE(numout,*) '      Iron half saturation for nanophyto       concnfer  = ', concnfer 
     273         WRITE(numout,*) '      Iron half saturation for diatoms         concdfer  = ', concdfer 
     274         WRITE(numout,*) '      size ratio for nanophytoplankton         xsizern   = ', xsizern 
     275         WRITE(numout,*) '      size ratio for diatoms                   xsizerd   = ', xsizerd 
     276         WRITE(numout,*) '      NO3 half saturation of bacteria          concbno3  = ', concbno3 
     277         WRITE(numout,*) '      NH4 half saturation for bacteria         concbnh4  = ', concbnh4 
     278         WRITE(numout,*) '      Minimum size criteria for diatoms        xsizedia  = ', xsizedia 
     279         WRITE(numout,*) '      Minimum size criteria for nanophyto      xsizephy  = ', xsizephy 
     280         WRITE(numout,*) '      Fe half saturation for bacteria          concbfe   = ', concbfe 
     281         WRITE(numout,*) '      halk saturation constant for anoxia       oxymin   =' , oxymin 
     282         WRITE(numout,*) '      optimal Fe quota for nano.               qnfelim   = ', qnfelim 
     283         WRITE(numout,*) '      Optimal Fe quota for diatoms             qdfelim   = ', qdfelim 
    281284      ENDIF 
    282285      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90

    r9125 r9169  
    2929   PUBLIC   p4z_lys_init    ! called in trcsms_pisces.F90 
    3030 
    31    !! * Shared module variables 
    32    REAL(wp), PUBLIC :: kdca !: diss. rate constant calcite 
    33    REAL(wp), PUBLIC :: nca  !: order of reaction for calcite dissolution 
     31   REAL(wp), PUBLIC ::   kdca   !: diss. rate constant calcite 
     32   REAL(wp), PUBLIC ::   nca    !: order of reaction for calcite dissolution 
    3433 
    35    !! * Module variables 
    36    REAL(wp) :: calcon = 1.03E-2           !: mean calcite concentration [Ca2+] in sea water [mole/kg solution] 
     34   INTEGER  ::   rmtss              ! number of seconds per month  
     35   REAL(wp) ::   calcon = 1.03E-2   ! mean calcite concentration [Ca2+] in sea water [mole/kg solution] 
    3736  
    38    INTEGER  :: rmtss                      !: number of seconds per month  
    39  
    4037   !!---------------------------------------------------------------------- 
    4138   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    5653      !! ** Method  : - ??? 
    5754      !!--------------------------------------------------------------------- 
     55      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ??? 
    5856      ! 
    59       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
    6057      INTEGER  ::   ji, jj, jk, jn 
    6158      REAL(wp) ::   zdispot, zfact, zcalcon 
    6259      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    63       CHARACTER (len=25) :: charout 
    64       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zco3, zcaldiss, zhinit, zhi, zco3sat 
     60      CHARACTER (len=25) ::   charout 
     61      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zco3, zcaldiss, zhinit, zhi, zco3sat 
    6562      !!--------------------------------------------------------------------- 
    6663      ! 
    … …  
    6966      zco3    (:,:,:) = 0. 
    7067      zcaldiss(:,:,:) = 0. 
    71       zhinit(:,:,:)   = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 
     68      zhinit  (:,:,:) = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 
     69      ! 
    7270      !     ------------------------------------------- 
    7371      !     COMPUTE [CO3--] and [H+] CONCENTRATIONS 
    7472      !     ------------------------------------------- 
    7573 
    76       CALL solve_at_general(zhinit, zhi) 
     74      CALL solve_at_general( zhinit, zhi ) 
    7775 
    7876      DO jk = 1, jpkm1 
    … …  
    8078            DO ji = 1, jpi 
    8179               zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   & 
    82                &                + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 
    83                hi(ji,jj,jk)  = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 
     80                  &             + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 
     81               hi  (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 
    8482            END DO 
    8583         END DO 
    … …  
    158156      NAMELIST/nampiscal/ kdca, nca 
    159157      !!---------------------------------------------------------------------- 
     158      IF(lwp) THEN 
     159         WRITE(numout,*) 
     160         WRITE(numout,*) 'p4z_lys_init : initialization of CaCO3 dissolution' 
     161         WRITE(numout,*) '~~~~~~~~~~~~' 
     162      ENDIF 
    160163      ! 
    161164      REWIND( numnatp_ref )              ! Namelist nampiscal in reference namelist : Pisces CaCO3 dissolution 
    162165      READ  ( numnatp_ref, nampiscal, IOSTAT = ios, ERR = 901) 
    163 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiscal in reference namelist', lwp ) 
    164       ! 
     166901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampiscal in reference namelist', lwp ) 
    165167      REWIND( numnatp_cfg )              ! Namelist nampiscal in configuration namelist : Pisces CaCO3 dissolution 
    166168      READ  ( numnatp_cfg, nampiscal, IOSTAT = ios, ERR = 902 ) 
    167 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampiscal in configuration namelist', lwp ) 
    168       IF(lwm) WRITE ( numonp, nampiscal ) 
     169902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampiscal in configuration namelist', lwp ) 
     170      IF(lwm) WRITE( numonp, nampiscal ) 
    169171      ! 
    170172      IF(lwp) THEN                         ! control print 
    171          WRITE(numout,*) ' ' 
    172          WRITE(numout,*) ' Namelist parameters for CaCO3 dissolution, nampiscal' 
    173          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    174          WRITE(numout,*) '    diss. rate constant calcite (per month)   kdca      =', kdca 
    175          WRITE(numout,*) '    order of reaction for calcite dissolution nca       =', nca 
     173         WRITE(numout,*) '   Namelist : nampiscal' 
     174         WRITE(numout,*) '      diss. rate constant calcite (per month)        kdca =', kdca 
     175         WRITE(numout,*) '      order of reaction for calcite dissolution      nca  =', nca 
    176176      ENDIF 
    177177      ! 
    … …  
    180180      ! 
    181181   END SUBROUTINE p4z_lys_init 
     182 
    182183   !!====================================================================== 
    183184END MODULE p4zlys 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90

    r9125 r9169  
    88   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    99   !!---------------------------------------------------------------------- 
    10    !!   p4z_meso       :   Compute the sources/sinks for mesozooplankton 
    11    !!   p4z_meso_init  :   Initialization of the parameters for mesozooplankton 
    12    !!---------------------------------------------------------------------- 
    13    USE oce_trc         !  shared variables between ocean and passive tracers 
    14    USE trc             !  passive tracers common variables  
    15    USE sms_pisces      !  PISCES Source Minus Sink variables 
    16    USE p4zprod         !  production 
    17    USE prtctl_trc      !  print control for debugging 
    18    USE iom             !  I/O manager 
     10   !!   p4z_meso       : Compute the sources/sinks for mesozooplankton 
     11   !!   p4z_meso_init  : Initialization of the parameters for mesozooplankton 
     12   !!---------------------------------------------------------------------- 
     13   USE oce_trc         ! shared variables between ocean and passive tracers 
     14   USE trc             ! passive tracers common variables  
     15   USE sms_pisces      ! PISCES Source Minus Sink variables 
     16   USE p4zprod         ! production 
     17   USE prtctl_trc      ! print control for debugging 
     18   USE iom             ! I/O manager 
    1919 
    2020   IMPLICIT NONE 
    … …  
    2424   PUBLIC   p4z_meso_init         ! called in trcsms_pisces.F90 
    2525 
    26    !! * Shared module variables 
    2726   REAL(wp), PUBLIC ::  part2        !: part of calcite not dissolved in mesozoo guts 
    2827   REAL(wp), PUBLIC ::  xprefc       !: mesozoo preference for POC  
    … …  
    4948   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5049   !!---------------------------------------------------------------------- 
    51  
    5250CONTAINS 
    5351 
    … …  
    6058      !! ** Method  : - ??? 
    6159      !!--------------------------------------------------------------------- 
    62       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     60      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ??? 
     61      ! 
    6362      INTEGER  :: ji, jj, jk 
    6463      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam 
    … …  
    7372      CHARACTER (len=25) :: charout 
    7473      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing 
    75       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 
    76  
     74      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zw3d 
    7775      !!--------------------------------------------------------------------- 
    7876      ! 
    … …  
    122120 
    123121               !  Mesozooplankton flux feeding on GOC 
    124                !  ---------------------------------- 
    125122               !  ---------------------------------- 
    126123               zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    … …  
    253250      !! 
    254251      !! ** input   :   Namelist nampismes 
    255       !! 
    256252      !!---------------------------------------------------------------------- 
    257253      INTEGER ::   ios   ! Local integer 
    … …  
    262258      !!---------------------------------------------------------------------- 
    263259      ! 
     260      IF(lwp) THEN 
     261         WRITE(numout,*)  
     262         WRITE(numout,*) 'p4z_meso_init : Initialization of mesozooplankton parameters' 
     263         WRITE(numout,*) '~~~~~~~~~~~~~' 
     264      ENDIF 
     265      ! 
    264266      REWIND( numnatp_ref )              ! Namelist nampismes in reference namelist : Pisces mesozooplankton 
    265267      READ  ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901) 
    266 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in reference namelist', lwp ) 
    267       ! 
     268901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmes in reference namelist', lwp ) 
    268269      REWIND( numnatp_cfg )              ! Namelist nampismes in configuration namelist : Pisces mesozooplankton 
    269270      READ  ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 ) 
    270 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp4zmes in configuration namelist', lwp ) 
    271       IF(lwm) WRITE ( numonp, namp4zmes ) 
     271902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmes in configuration namelist', lwp ) 
     272      IF(lwm) WRITE( numonp, namp4zmes ) 
    272273      ! 
    273274      IF(lwp) THEN                         ! control print 
    274          WRITE(numout,*) ' '  
    275          WRITE(numout,*) ' Namelist parameters for mesozooplankton, namp4zmes' 
    276          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    277          WRITE(numout,*) '    part of calcite not dissolved in mesozoo guts  part2        =', part2 
    278          WRITE(numout,*) '    mesozoo preference for phyto                   xprefc       =', xprefc 
    279          WRITE(numout,*) '    mesozoo preference for POC                     xprefp       =', xprefp 
    280          WRITE(numout,*) '    mesozoo preference for zoo                     xprefz       =', xprefz 
    281          WRITE(numout,*) '    mesozoo preference for poc                     xprefpoc     =', xprefpoc 
    282          WRITE(numout,*) '    microzoo feeding threshold  for mesozoo        xthresh2zoo  =', xthresh2zoo 
    283          WRITE(numout,*) '    diatoms feeding threshold  for mesozoo         xthresh2dia  =', xthresh2dia 
    284          WRITE(numout,*) '    nanophyto feeding threshold for mesozoo        xthresh2phy  =', xthresh2phy 
    285          WRITE(numout,*) '    poc feeding threshold for mesozoo              xthresh2poc  =', xthresh2poc 
    286          WRITE(numout,*) '    feeding threshold for mesozooplankton          xthresh2     =', xthresh2 
    287          WRITE(numout,*) '    exsudation rate of mesozooplankton             resrat2      =', resrat2 
    288          WRITE(numout,*) '    mesozooplankton mortality rate                 mzrat2       =', mzrat2 
    289          WRITE(numout,*) '    maximal mesozoo grazing rate                   grazrat2     =', grazrat2 
    290          WRITE(numout,*) '    mesozoo flux feeding rate                      grazflux     =', grazflux 
    291          WRITE(numout,*) '    non assimilated fraction of P by mesozoo       unass2       =', unass2 
    292          WRITE(numout,*) '    Efficicency of Mesozoo growth                  epsher2      =', epsher2 
    293          WRITE(numout,*) '    Fraction of mesozoo excretion as DOM           sigma2       =', sigma2 
    294          WRITE(numout,*) '    half sturation constant for grazing 2          xkgraz2      =', xkgraz2 
     275         WRITE(numout,*) '   Namelist : namp4zmes' 
     276         WRITE(numout,*) '      part of calcite not dissolved in mesozoo guts  part2        =', part2 
     277         WRITE(numout,*) '      mesozoo preference for phyto                   xprefc       =', xprefc 
     278         WRITE(numout,*) '      mesozoo preference for POC                     xprefp       =', xprefp 
     279         WRITE(numout,*) '      mesozoo preference for zoo                     xprefz       =', xprefz 
     280         WRITE(numout,*) '      mesozoo preference for poc                     xprefpoc     =', xprefpoc 
     281         WRITE(numout,*) '      microzoo feeding threshold  for mesozoo        xthresh2zoo  =', xthresh2zoo 
     282         WRITE(numout,*) '      diatoms feeding threshold  for mesozoo         xthresh2dia  =', xthresh2dia 
     283         WRITE(numout,*) '      nanophyto feeding threshold for mesozoo        xthresh2phy  =', xthresh2phy 
     284         WRITE(numout,*) '      poc feeding threshold for mesozoo              xthresh2poc  =', xthresh2poc 
     285         WRITE(numout,*) '      feeding threshold for mesozooplankton          xthresh2     =', xthresh2 
     286         WRITE(numout,*) '      exsudation rate of mesozooplankton             resrat2      =', resrat2 
     287         WRITE(numout,*) '      mesozooplankton mortality rate                 mzrat2       =', mzrat2 
     288         WRITE(numout,*) '      maximal mesozoo grazing rate                   grazrat2     =', grazrat2 
     289         WRITE(numout,*) '      mesozoo flux feeding rate                      grazflux     =', grazflux 
     290         WRITE(numout,*) '      non assimilated fraction of P by mesozoo       unass2       =', unass2 
     291         WRITE(numout,*) '      Efficicency of Mesozoo growth                  epsher2      =', epsher2 
     292         WRITE(numout,*) '      Fraction of mesozoo excretion as DOM           sigma2       =', sigma2 
     293         WRITE(numout,*) '      half sturation constant for grazing 2          xkgraz2      =', xkgraz2 
    295294      ENDIF 
    296295      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90

    r9125 r9169  
    88   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    99   !!---------------------------------------------------------------------- 
    10    !!   p4z_micro       :  Compute the sources/sinks for microzooplankton 
    11    !!   p4z_micro_init  :  Initialize and read the appropriate namelist 
    12    !!---------------------------------------------------------------------- 
    13    USE oce_trc         !  shared variables between ocean and passive tracers 
    14    USE trc             !  passive tracers common variables  
    15    USE sms_pisces      !  PISCES Source Minus Sink variables 
    16    USE p4zlim          !  Co-limitations 
    17    USE p4zprod         !  production 
    18    USE iom             !  I/O manager 
    19    USE prtctl_trc      !  print control for debugging 
     10   !!   p4z_micro      : Compute the sources/sinks for microzooplankton 
     11   !!   p4z_micro_init : Initialize and read the appropriate namelist 
     12   !!---------------------------------------------------------------------- 
     13   USE oce_trc         ! shared variables between ocean and passive tracers 
     14   USE trc             ! passive tracers common variables  
     15   USE sms_pisces      ! PISCES Source Minus Sink variables 
     16   USE p4zlim          ! Co-limitations 
     17   USE p4zprod         ! production 
     18   USE iom             ! I/O manager 
     19   USE prtctl_trc      ! print control for debugging 
    2020 
    2121   IMPLICIT NONE 
    … …  
    2525   PUBLIC   p4z_micro_init    ! called in trcsms_pisces.F90 
    2626 
    27    !! * Shared module variables 
    28    REAL(wp), PUBLIC ::  part        !: part of calcite not dissolved in microzoo guts 
    29    REAL(wp), PUBLIC ::  xpref2c     !: microzoo preference for POC  
    30    REAL(wp), PUBLIC ::  xpref2p     !: microzoo preference for nanophyto 
    31    REAL(wp), PUBLIC ::  xpref2d     !: microzoo preference for diatoms 
    32    REAL(wp), PUBLIC ::  xthreshdia  !: diatoms feeding threshold for microzooplankton  
    33    REAL(wp), PUBLIC ::  xthreshphy  !: nanophyto threshold for microzooplankton  
    34    REAL(wp), PUBLIC ::  xthreshpoc  !: poc threshold for microzooplankton  
    35    REAL(wp), PUBLIC ::  xthresh     !: feeding threshold for microzooplankton  
    36    REAL(wp), PUBLIC ::  resrat      !: exsudation rate of microzooplankton 
    37    REAL(wp), PUBLIC ::  mzrat       !: microzooplankton mortality rate  
    38    REAL(wp), PUBLIC ::  grazrat     !: maximal microzoo grazing rate 
    39    REAL(wp), PUBLIC ::  xkgraz      !: non assimilated fraction of P by microzoo  
    40    REAL(wp), PUBLIC ::  unass       !: Efficicency of microzoo growth  
    41    REAL(wp), PUBLIC ::  sigma1      !: Fraction of microzoo excretion as DOM  
    42    REAL(wp), PUBLIC ::  epsher      !: half sturation constant for grazing 1  
     27   REAL(wp), PUBLIC ::   part        !: part of calcite not dissolved in microzoo guts 
     28   REAL(wp), PUBLIC ::   xpref2c     !: microzoo preference for POC  
     29   REAL(wp), PUBLIC ::   xpref2p     !: microzoo preference for nanophyto 
     30   REAL(wp), PUBLIC ::   xpref2d     !: microzoo preference for diatoms 
     31   REAL(wp), PUBLIC ::   xthreshdia  !: diatoms feeding threshold for microzooplankton  
     32   REAL(wp), PUBLIC ::   xthreshphy  !: nanophyto threshold for microzooplankton  
     33   REAL(wp), PUBLIC ::   xthreshpoc  !: poc threshold for microzooplankton  
     34   REAL(wp), PUBLIC ::   xthresh     !: feeding threshold for microzooplankton  
     35   REAL(wp), PUBLIC ::   resrat      !: exsudation rate of microzooplankton 
     36   REAL(wp), PUBLIC ::   mzrat       !: microzooplankton mortality rate  
     37   REAL(wp), PUBLIC ::   grazrat     !: maximal microzoo grazing rate 
     38   REAL(wp), PUBLIC ::   xkgraz      !: non assimilated fraction of P by microzoo  
     39   REAL(wp), PUBLIC ::   unass       !: Efficicency of microzoo growth  
     40   REAL(wp), PUBLIC ::   sigma1      !: Fraction of microzoo excretion as DOM  
     41   REAL(wp), PUBLIC ::   epsher      !: half sturation constant for grazing 1  
    4342 
    4443   !!---------------------------------------------------------------------- 
    … …  
    5756      !! ** Method  : - ??? 
    5857      !!--------------------------------------------------------------------- 
    59       INTEGER, INTENT(in) ::  kt  ! ocean time step 
    60       INTEGER, INTENT(in) ::  knt  
     58      INTEGER, INTENT(in) ::   kt    ! ocean time step 
     59      INTEGER, INTENT(in) ::   knt   ! ???  
    6160      ! 
    6261      INTEGER  :: ji, jj, jk 
    … …  
    185184      ENDIF 
    186185      ! 
    187       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     186      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
    188187         WRITE(charout, FMT="('micro')") 
    189188         CALL prt_ctl_trc_info(charout) 
    … …  
    215214      !!---------------------------------------------------------------------- 
    216215      ! 
     216      IF(lwp) THEN 
     217         WRITE(numout,*)  
     218         WRITE(numout,*) 'p4z_micro_init : Initialization of microzooplankton parameters' 
     219         WRITE(numout,*) '~~~~~~~~~~~~~~' 
     220      ENDIF 
     221      ! 
    217222      REWIND( numnatp_ref )              ! Namelist nampiszoo in reference namelist : Pisces microzooplankton 
    218223      READ  ( numnatp_ref, namp4zzoo, IOSTAT = ios, ERR = 901) 
    219 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in reference namelist', lwp ) 
    220       ! 
     224901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zzoo in reference namelist', lwp ) 
    221225      REWIND( numnatp_cfg )              ! Namelist nampiszoo in configuration namelist : Pisces microzooplankton 
    222226      READ  ( numnatp_cfg, namp4zzoo, IOSTAT = ios, ERR = 902 ) 
    223 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist', lwp ) 
    224       IF(lwm) WRITE ( numonp, namp4zzoo ) 
     227902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist', lwp ) 
     228      IF(lwm) WRITE( numonp, namp4zzoo ) 
    225229      ! 
    226230      IF(lwp) THEN                         ! control print 
    227          WRITE(numout,*) ' ' 
    228          WRITE(numout,*) ' Namelist parameters for microzooplankton, namp4zzoo' 
    229          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    230          WRITE(numout,*) '    part of calcite not dissolved in microzoo guts  part        =', part 
    231          WRITE(numout,*) '    microzoo preference for POC                     xpref2c     =', xpref2c 
    232          WRITE(numout,*) '    microzoo preference for nano                    xpref2p     =', xpref2p 
    233          WRITE(numout,*) '    microzoo preference for diatoms                 xpref2d     =', xpref2d 
    234          WRITE(numout,*) '    diatoms feeding threshold  for microzoo         xthreshdia  =', xthreshdia 
    235          WRITE(numout,*) '    nanophyto feeding threshold for microzoo        xthreshphy  =', xthreshphy 
    236          WRITE(numout,*) '    poc feeding threshold for microzoo              xthreshpoc  =', xthreshpoc 
    237          WRITE(numout,*) '    feeding threshold for microzooplankton          xthresh     =', xthresh 
    238          WRITE(numout,*) '    exsudation rate of microzooplankton             resrat      =', resrat 
    239          WRITE(numout,*) '    microzooplankton mortality rate                 mzrat       =', mzrat 
    240          WRITE(numout,*) '    maximal microzoo grazing rate                   grazrat     =', grazrat 
    241          WRITE(numout,*) '    non assimilated fraction of P by microzoo       unass       =', unass 
    242          WRITE(numout,*) '    Efficicency of microzoo growth                  epsher      =', epsher 
    243          WRITE(numout,*) '    Fraction of microzoo excretion as DOM           sigma1      =', sigma1 
    244          WRITE(numout,*) '    half sturation constant for grazing 1           xkgraz      =', xkgraz 
     231         WRITE(numout,*) '   Namelist : namp4zzoo' 
     232         WRITE(numout,*) '      part of calcite not dissolved in microzoo guts  part        =', part 
     233         WRITE(numout,*) '      microzoo preference for POC                     xpref2c     =', xpref2c 
     234         WRITE(numout,*) '      microzoo preference for nano                    xpref2p     =', xpref2p 
     235         WRITE(numout,*) '      microzoo preference for diatoms                 xpref2d     =', xpref2d 
     236         WRITE(numout,*) '      diatoms feeding threshold  for microzoo         xthreshdia  =', xthreshdia 
     237         WRITE(numout,*) '      nanophyto feeding threshold for microzoo        xthreshphy  =', xthreshphy 
     238         WRITE(numout,*) '      poc feeding threshold for microzoo              xthreshpoc  =', xthreshpoc 
     239         WRITE(numout,*) '      feeding threshold for microzooplankton          xthresh     =', xthresh 
     240         WRITE(numout,*) '      exsudation rate of microzooplankton             resrat      =', resrat 
     241         WRITE(numout,*) '      microzooplankton mortality rate                 mzrat       =', mzrat 
     242         WRITE(numout,*) '      maximal microzoo grazing rate                   grazrat     =', grazrat 
     243         WRITE(numout,*) '      non assimilated fraction of P by microzoo       unass       =', unass 
     244         WRITE(numout,*) '      Efficicency of microzoo growth                  epsher      =', epsher 
     245         WRITE(numout,*) '      Fraction of microzoo excretion as DOM           sigma1      =', sigma1 
     246         WRITE(numout,*) '      half sturation constant for grazing 1           xkgraz      =', xkgraz 
    245247      ENDIF 
    246248      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90

    r9124 r9169  
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!---------------------------------------------------------------------- 
    9    !!   p4z_mort       :   Compute the mortality terms for phytoplankton 
    10    !!   p4z_mort_init  :   Initialize the mortality params for phytoplankton 
    11    !!---------------------------------------------------------------------- 
    12    USE oce_trc         !  shared variables between ocean and passive tracers 
    13    USE trc             !  passive tracers common variables  
    14    USE sms_pisces      !  PISCES Source Minus Sink variables 
    15    USE p4zprod         !  Primary productivity  
    16    USE p4zlim          !  Phytoplankton limitation terms 
    17    USE prtctl_trc      !  print control for debugging 
     9   !!   p4z_mort       : Compute the mortality terms for phytoplankton 
     10   !!   p4z_mort_init  : Initialize the mortality params for phytoplankton 
     11   !!---------------------------------------------------------------------- 
     12   USE oce_trc         ! shared variables between ocean and passive tracers 
     13   USE trc             ! passive tracers common variables  
     14   USE sms_pisces      ! PISCES Source Minus Sink variables 
     15   USE p4zprod         ! Primary productivity  
     16   USE p4zlim          ! Phytoplankton limitation terms 
     17   USE prtctl_trc      ! print control for debugging 
    1818 
    1919   IMPLICIT NONE 
    … …  
    2323   PUBLIC   p4z_mort_init     
    2424 
    25    !! * Shared module variables 
    26    REAL(wp), PUBLIC :: wchl    !: 
    27    REAL(wp), PUBLIC :: wchld   !: 
    28    REAL(wp), PUBLIC :: wchldm  !: 
    29    REAL(wp), PUBLIC :: mprat   !: 
    30    REAL(wp), PUBLIC :: mprat2  !: 
     25   REAL(wp), PUBLIC ::   wchl     !: 
     26   REAL(wp), PUBLIC ::   wchld    !: 
     27   REAL(wp), PUBLIC ::   wchldm   !: 
     28   REAL(wp), PUBLIC ::   mprat    !: 
     29   REAL(wp), PUBLIC ::   mprat2   !: 
    3130 
    3231   !!---------------------------------------------------------------------- 
    … …  
    3534   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3635   !!---------------------------------------------------------------------- 
    37  
    3836CONTAINS 
    3937 
    … …  
    4947      INTEGER, INTENT(in) ::   kt ! ocean time step 
    5048      !!--------------------------------------------------------------------- 
    51  
     49      ! 
    5250      CALL p4z_nano            ! nanophytoplankton 
    53  
     51      ! 
    5452      CALL p4z_diat            ! diatoms 
    55  
     53      ! 
    5654   END SUBROUTINE p4z_mort 
    5755 
    … …  
    6563      !! ** Method  : - ??? 
    6664      !!--------------------------------------------------------------------- 
    67       INTEGER  :: ji, jj, jk 
    68       REAL(wp) :: zsizerat, zcompaph 
    69       REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal 
    70       REAL(wp) :: ztortp , zrespp , zmortp  
    71       CHARACTER (len=25) :: charout 
     65      INTEGER  ::   ji, jj, jk 
     66      REAL(wp) ::   zsizerat, zcompaph 
     67      REAL(wp) ::   zfactfe, zfactch, zprcaca, zfracal 
     68      REAL(wp) ::   ztortp , zrespp , zmortp  
     69      CHARACTER (len=25) ::   charout 
    7270      !!--------------------------------------------------------------------- 
    7371      ! 
    7472      IF( ln_timing )   CALL timing_start('p4z_nano') 
    7573      ! 
    76       prodcal(:,:,:) = 0.  !: calcite production variable set to zero 
     74      prodcal(:,:,:) = 0._wp   ! calcite production variable set to zero 
    7775      DO jk = 1, jpkm1 
    7876         DO jj = 1, jpj 
    … …  
    139137      !! ** Method  : - ??? 
    140138      !!--------------------------------------------------------------------- 
    141       INTEGER  ::  ji, jj, jk 
    142       REAL(wp) ::  zfactfe,zfactsi,zfactch, zcompadi 
    143       REAL(wp) ::  zrespp2, ztortp2, zmortp2 
    144       REAL(wp) ::  zlim2, zlim1 
    145       CHARACTER (len=25) :: charout 
     139      INTEGER  ::   ji, jj, jk 
     140      REAL(wp) ::   zfactfe,zfactsi,zfactch, zcompadi 
     141      REAL(wp) ::   zrespp2, ztortp2, zmortp2 
     142      REAL(wp) ::   zlim2, zlim1 
     143      CHARACTER (len=25) ::   charout 
    146144      !!--------------------------------------------------------------------- 
    147145      ! 
    148146      IF( ln_timing )   CALL timing_start('p4z_diat') 
    149147      ! 
    150  
    151148      !    Aggregation term for diatoms is increased in case of nutrient 
    152149      !    stress as observed in reality. The stressed cells become more 
    … …  
    196193      END DO 
    197194      ! 
    198       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     195      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
    199196         WRITE(charout, FMT="('diat')") 
    200197         CALL prt_ctl_trc_info(charout) 
    … …  
    214211      !! 
    215212      !! ** Method  :   Read the nampismort namelist and check the parameters 
    216       !!      called at the first timestep 
     213      !!              called at the first timestep 
    217214      !! 
    218215      !! ** input   :   Namelist nampismort 
    … …  
    224221      !!---------------------------------------------------------------------- 
    225222      ! 
     223      IF(lwp) THEN 
     224         WRITE(numout,*)  
     225         WRITE(numout,*) 'p4z_mort_init : Initialization of phytoplankton mortality parameters' 
     226         WRITE(numout,*) '~~~~~~~~~~~~~' 
     227      ENDIF 
     228      ! 
    226229      REWIND( numnatp_ref )              ! Namelist nampismort in reference namelist : Pisces phytoplankton 
    227230      READ  ( numnatp_ref, namp4zmort, IOSTAT = ios, ERR = 901) 
    228 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in reference namelist', lwp ) 
    229       ! 
     231901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmort in reference namelist', lwp ) 
    230232      REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton 
    231233      READ  ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 ) 
    232 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp4zmort in configuration namelist', lwp ) 
    233       IF(lwm) WRITE ( numonp, namp4zmort ) 
     234902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmort in configuration namelist', lwp ) 
     235      IF(lwm) WRITE( numonp, namp4zmort ) 
    234236      ! 
    235237      IF(lwp) THEN                         ! control print 
    236          WRITE(numout,*) ' ' 
    237          WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, namp4zmort' 
    238          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    239          WRITE(numout,*) '    quadratic mortality of phytoplankton      wchl      =', wchl 
    240          WRITE(numout,*) '    maximum quadratic mortality of diatoms    wchld     =', wchld 
    241          WRITE(numout,*) '    maximum quadratic mortality of diatoms    wchldm    =', wchldm 
    242          WRITE(numout,*) '    phytoplankton mortality rate              mprat     =', mprat 
    243          WRITE(numout,*) '    Diatoms mortality rate                    mprat2    =', mprat2 
     238         WRITE(numout,*) '   Namelist : namp4zmort' 
     239         WRITE(numout,*) '      quadratic mortality of phytoplankton        wchl   =', wchl 
     240         WRITE(numout,*) '      maximum quadratic mortality of diatoms      wchld  =', wchld 
     241         WRITE(numout,*) '      maximum quadratic mortality of diatoms      wchldm =', wchldm 
     242         WRITE(numout,*) '      phytoplankton mortality rate                mprat  =', mprat 
     243         WRITE(numout,*) '      Diatoms mortality rate                      mprat2 =', mprat2 
    244244      ENDIF 
    245245      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r9125 r9169  
    44   !! TOP - PISCES : Compute the light availability in the water column 
    55   !!====================================================================== 
    6    !! History :   1.0  !  2004     (O. Aumont) Original code 
    7    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    8    !!             3.2  !  2009-04  (C. Ethe, G. Madec)  optimisation 
    9    !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improve light availability of nano & diat 
     6   !! History :  1.0  !  2004     (O. Aumont) Original code 
     7   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!            3.2  !  2009-04  (C. Ethe, G. Madec)  optimisation 
     9   !!            3.4  !  2011-06  (O. Aumont, C. Ethe) Improve light availability of nano & diat 
    1010   !!---------------------------------------------------------------------- 
    1111   !!   p4z_opt       : light availability in the water column 
    … …  
    1515   USE sms_pisces     ! Source Minus Sink of PISCES 
    1616   USE iom            ! I/O manager 
    17    USE fldread         !  time interpolation 
    18    USE prtctl_trc      !  print control for debugging 
     17   USE fldread        !  time interpolation 
     18   USE prtctl_trc     !  print control for debugging 
    1919 
    2020   IMPLICIT NONE 
    … …  
    2727   !! * Shared module variables 
    2828 
    29    LOGICAL  :: ln_varpar   !: boolean for variable PAR fraction 
    30    REAL(wp) :: parlux      !: Fraction of shortwave as PAR 
    31    REAL(wp) :: xparsw                 !: parlux/3 
    32    REAL(wp) :: xsi0r                 !: 1. /rn_si0 
     29   LOGICAL  ::   ln_varpar   ! boolean for variable PAR fraction 
     30   REAL(wp) ::   parlux      ! Fraction of shortwave as PAR 
     31   REAL(wp) ::   xparsw      ! parlux/3 
     32   REAL(wp) ::   xsi0r       ! 1. /rn_si0 
    3333 
    3434   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_par      ! structure of input par 
    3535   INTEGER , PARAMETER :: nbtimes = 366  !: maximum number of times record in a file 
    3636   INTEGER  :: ntimes_par                ! number of time steps in a file 
    37    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: par_varsw    !: PAR fraction of shortwave 
    38    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr  !: wavelength (Red-Green-Blue) 
     37   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   par_varsw      ! PAR fraction of shortwave 
     38   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ekb, ekg, ekr  ! wavelength (Red-Green-Blue) 
    3939 
    4040   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    4141 
    42    REAL(wp), DIMENSION(3,61) ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption 
     42   REAL(wp), DIMENSION(3,61) ::   xkrgb   ! tabulated attenuation coefficients for RGB absorption 
    4343    
    4444   !!---------------------------------------------------------------------- 
    … …  
    7070      !!--------------------------------------------------------------------- 
    7171      ! 
    72       IF( ln_timing )  CALL timing_start('p4z_opt') 
    73       ! 
    74       ! Allocate temporary workspace 
    75       IF( ln_p5z ) ALLOCATE( zetmp5(jpi,jpj) ) 
    76  
    77       IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) 
     72      IF( ln_timing )   CALL timing_start('p4z_opt') 
     73      IF( ln_p5z    )   ALLOCATE( zetmp5(jpi,jpj) ) 
     74 
     75      IF( knt == 1 .AND. ln_varpar )   CALL p4z_opt_sbc( kt ) 
    7876 
    7977      !     Initialisation of variables used to compute PAR 
    … …  
    8482      ! 
    8583      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
    86                                                !  -------------------------------------------------------- 
    87                     zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 
    88       IF( ln_p5z )  zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch) 
     84      !                                        !  -------------------------------------------------------- 
     85                     zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 
     86      IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + trb(:,:,:,jppch) 
    8987      ! 
    9088      DO jk = 1, jpkm1    
    … …  
    105103      IF( l_trcdm2dc ) THEN                     !  diurnal cycle 
    106104         ! 
    107          zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn ) 
     105         zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    108106         ! 
    109107         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )  
    … …  
    120118         ENDIF 
    121119         ! 
    122          zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 
     120         zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    123121         ! 
    124122         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )  
    … …  
    130128      ELSE 
    131129         ! 
    132          zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 
     130         zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    133131         ! 
    134132         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  )  
    … …  
    240238      ENDIF 
    241239      ! 
    242       IF( ln_p5z ) DEALLOCATE( zetmp5 ) 
    243       ! 
    244       IF( ln_timing )  CALL timing_stop('p4z_opt') 
     240      IF( ln_p5z    )   DEALLOCATE( zetmp5 ) 
     241      IF( ln_timing )   CALL timing_stop('p4z_opt') 
    245242      ! 
    246243   END SUBROUTINE p4z_opt 
    … …  
    255252      !! 
    256253      !!---------------------------------------------------------------------- 
    257       !! * arguments 
    258       INTEGER, INTENT(in)                                       ::  kt            !   ocean time-step 
    259       REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in)              ::  pqsr          !   shortwave 
    260       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::  pe1 , pe2 , pe3   !  PAR ( R-G-B) 
    261       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL ::  pe0   
    262       REAL(wp), DIMENSION(jpi,jpj)    , INTENT(out)  , OPTIONAL  ::  pqsr100   
    263       !! * local variables 
     254      INTEGER                         , INTENT(in)              ::   kt                ! ocean time-step 
     255      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   )           ::   pqsr              ! shortwave 
     256      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pe1 , pe2 , pe3   ! PAR ( R-G-B) 
     257      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL ::   pe0               ! 
     258      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(  out), OPTIONAL ::   pqsr100           ! 
     259      ! 
    264260      INTEGER    ::   ji, jj, jk     ! dummy loop indices 
    265       REAL(wp), DIMENSION(jpi,jpj)     ::  zqsr          !  shortwave 
     261      REAL(wp), DIMENSION(jpi,jpj) ::  zqsr   ! shortwave 
    266262      !!---------------------------------------------------------------------- 
    267263 
    … …  
    272268       
    273269      !  Light at the euphotic depth  
    274       IF( PRESENT( pqsr100 ) )  pqsr100(:,:) = 0.01 * 3. * zqsr(:,:) 
     270      IF( PRESENT( pqsr100 ) )   pqsr100(:,:) = 0.01 * 3. * zqsr(:,:) 
    275271 
    276272      IF( PRESENT( pe0 ) ) THEN     !  W-level 
    … …  
    285281               DO ji = 1, jpi 
    286282                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r ) 
    287                   pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) ) 
    288                   pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) ) 
    289                   pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr(ji,jj,jk-1 ) ) 
     283                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb  (ji,jj,jk-1 )        ) 
     284                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg  (ji,jj,jk-1 )        ) 
     285                  pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr  (ji,jj,jk-1 )        ) 
    290286               END DO 
    291287              ! 
    … …  
    327323      !! 
    328324      !!---------------------------------------------------------------------- 
    329       INTEGER ,                INTENT(in) ::   kt     ! ocean time step 
     325      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    330326      ! 
    331327      INTEGER  :: ji,jj 
    … …  
    357353      !! ** Input   :   external ascii and netcdf files 
    358354      !!---------------------------------------------------------------------- 
    359       INTEGER :: numpar 
    360       INTEGER :: ierr 
    361       INTEGER :: ios                 ! Local integer output status for namelist read 
    362       REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records 
     355      INTEGER :: numpar, ierr, ios   ! Local integer  
     356      REAL(wp), DIMENSION(nbtimes) ::   zsteps   ! times records 
    363357      ! 
    364358      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
    … …  
    367361      NAMELIST/nampisopt/cn_dir, sn_par, ln_varpar, parlux 
    368362      !!---------------------------------------------------------------------- 
    369  
     363      IF(lwp) THEN 
     364         WRITE(numout,*) 
     365         WRITE(numout,*) 'p4z_opt_init : ' 
     366         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     367      ENDIF 
    370368      REWIND( numnatp_ref )              ! Namelist nampisopt in reference namelist : Pisces attenuation coef. and PAR 
    371369      READ  ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901) 
    372 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in reference namelist', lwp ) 
    373  
     370901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisopt in reference namelist', lwp ) 
    374371      REWIND( numnatp_cfg )              ! Namelist nampisopt in configuration namelist : Pisces attenuation coef. and PAR 
    375372      READ  ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 ) 
    376 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in configuration namelist', lwp ) 
     373902   IF( ios >  0 )  CALL ctl_nam ( ios , 'nampisopt in configuration namelist', lwp ) 
    377374      IF(lwm) WRITE ( numonp, nampisopt ) 
    378375 
    379376      IF(lwp) THEN 
    380          WRITE(numout,*) ' ' 
    381          WRITE(numout,*) ' namelist : nampisopt ' 
    382          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ ' 
    383          WRITE(numout,*) '    PAR as a variable fraction of SW     ln_varpar      = ', ln_varpar 
    384          WRITE(numout,*) '    Default value for the PAR fraction   parlux         = ', parlux 
     377         WRITE(numout,*) '   Namelist : nampisopt ' 
     378         WRITE(numout,*) '      PAR as a variable fraction of SW     ln_varpar      = ', ln_varpar 
     379         WRITE(numout,*) '      Default value for the PAR fraction   parlux         = ', parlux 
    385380      ENDIF 
    386381      ! 
    … …  
    391386      ! ---------------------------------------- 
    392387      IF( ln_varpar ) THEN 
    393          IF(lwp) WRITE(numout,*) '    initialize variable par fraction ' 
    394          IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     388         IF(lwp) WRITE(numout,*) 
     389         IF(lwp) WRITE(numout,*) '   ==>>>   initialize variable par fraction (ln_varpar=T)' 
    395390         ! 
    396391         ALLOCATE( par_varsw(jpi,jpj) ) 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90

    r9125 r9169  
    2323   PUBLIC   p4z_poc         ! called in p4zbio.F90 
    2424   PUBLIC   p4z_poc_init    ! called in trcsms_pisces.F90 
    25    PUBLIC   alngam 
    26    PUBLIC   gamain 
    27  
    28    !! * Shared module variables 
    29    REAL(wp), PUBLIC ::  xremip     !: remineralisation rate of DOC 
    30    REAL(wp), PUBLIC ::  xremipc    !: remineralisation rate of DOC 
    31    REAL(wp), PUBLIC ::  xremipn    !: remineralisation rate of DON 
    32    REAL(wp), PUBLIC ::  xremipp    !: remineralisation rate of DOP 
    33    INTEGER , PUBLIC ::  jcpoc      !: number of lability classes 
    34    REAL(wp), PUBLIC ::  rshape     !: shape factor of the gamma distribution 
    35  
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   alphan, reminp 
    37    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: alphap 
     25   PUBLIC   alngam          ! 
     26   PUBLIC   gamain          ! 
     27 
     28   REAL(wp), PUBLIC ::   xremip     !: remineralisation rate of DOC 
     29   REAL(wp), PUBLIC ::   xremipc    !: remineralisation rate of DOC 
     30   REAL(wp), PUBLIC ::   xremipn    !: remineralisation rate of DON 
     31   REAL(wp), PUBLIC ::   xremipp    !: remineralisation rate of DOP 
     32   INTEGER , PUBLIC ::   jcpoc      !: number of lability classes 
     33   REAL(wp), PUBLIC ::   rshape     !: shape factor of the gamma distribution 
     34 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   alphan, reminp   !: 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   alphap           !: 
    3837 
    3938 
    … …  
    5352      !! ** Method  : - ??? 
    5453      !!--------------------------------------------------------------------- 
    55       ! 
    56       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     54      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ??? 
    5755      ! 
    5856      INTEGER  ::   ji, jj, jk, jn 
    … …  
    187185      END DO 
    188186 
    189       IF( ln_p4z ) THEN   ;  zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    190       ELSE                ;  zremigoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 
     187      IF( ln_p4z ) THEN   ;   zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
     188      ELSE                ;   zremigoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 
    191189      ENDIF 
    192190 
    … …  
    260258     ! ------------------------------------------------------------------- 
    261259     ! 
    262      totprod(:,:) = 0. 
     260     totprod (:,:) = 0. 
    263261     totthick(:,:) = 0. 
    264      totcons(:,:) = 0. 
     262     totcons (:,:) = 0. 
    265263     ! intregrated production and consumption of POC in the mixed layer 
    266264     ! ---------------------------------------------------------------- 
    … …  
    396394      END DO 
    397395 
    398      IF( ln_p4z ) THEN   ;  zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    399      ELSE                ;  zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 
     396     IF( ln_p4z ) THEN   ;   zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
     397     ELSE                ;   zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 
    400398     ENDIF 
    401399 
    … …  
    473471      !! 
    474472      !! ** Method  :   Read the nampispoc namelist and check the parameters 
    475       !!      called at the first timestep 
     473      !!              called at the first timestep 
    476474      !! 
    477475      !! ** input   :   Namelist nampispoc 
    478       !! 
    479476      !!---------------------------------------------------------------------- 
     477      INTEGER ::   jn            ! dummy loop index 
    480478      INTEGER ::   ios, ifault   ! Local integer 
    481       INTEGER ::   jn 
    482       REAL(wp) :: remindelta, reminup, remindown 
     479      REAL(wp)::   remindelta, reminup, remindown 
    483480      !! 
    484481      NAMELIST/nampispoc/ xremip , jcpoc  , rshape,  & 
    485482         &                xremipc, xremipn, xremipp 
    486483      !!---------------------------------------------------------------------- 
    487  
     484      ! 
     485      IF(lwp) THEN 
     486         WRITE(numout,*) 
     487         WRITE(numout,*) 'p4z_poc_init : Initialization of remineralization parameters' 
     488         WRITE(numout,*) '~~~~~~~~~~~~' 
     489      ENDIF 
     490      ! 
    488491      REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization 
    489492      READ  ( numnatp_ref, nampispoc, IOSTAT = ios, ERR = 901) 
    490 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampispoc in reference namelist', lwp ) 
    491  
     493901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampispoc in reference namelist', lwp ) 
    492494      REWIND( numnatp_cfg )              ! Namelist nampisrem in configuration namelist : Pisces remineralization 
    493495      READ  ( numnatp_cfg, nampispoc, IOSTAT = ios, ERR = 902 ) 
    494 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampispoc in configuration namelist', lwp ) 
    495       IF(lwm) WRITE ( numonp, nampispoc ) 
     496902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampispoc in configuration namelist', lwp ) 
     497      IF(lwm) WRITE( numonp, nampispoc ) 
    496498 
    497499      IF(lwp) THEN                         ! control print 
    498          WRITE(numout,*) ' ' 
    499          WRITE(numout,*) ' Namelist parameters for remineralization, nampispoc' 
    500          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     500         WRITE(numout,*) '   Namelist : nampispoc' 
    501501         IF( ln_p4z ) THEN 
    502             WRITE(numout,*) '    remineralisation rate of POC              xremip    =', xremip 
     502            WRITE(numout,*) '      remineralisation rate of POC              xremip    =', xremip 
    503503         ELSE 
    504             WRITE(numout,*) '    remineralisation rate of POC              xremipc   =', xremipc 
    505             WRITE(numout,*) '    remineralisation rate of PON              xremipn   =', xremipn 
    506             WRITE(numout,*) '    remineralisation rate of POP              xremipp   =', xremipp 
     504            WRITE(numout,*) '      remineralisation rate of POC              xremipc   =', xremipc 
     505            WRITE(numout,*) '      remineralisation rate of PON              xremipn   =', xremipn 
     506            WRITE(numout,*) '      remineralisation rate of POP              xremipp   =', xremipp 
    507507         ENDIF 
    508          WRITE(numout,*) '    Number of lability classes for POC        jcpoc     =', jcpoc 
    509          WRITE(numout,*) '    Shape factor of the gamma distribution    rshape    =', rshape 
     508         WRITE(numout,*) '      Number of lability classes for POC        jcpoc     =', jcpoc 
     509         WRITE(numout,*) '      Shape factor of the gamma distribution    rshape    =', rshape 
    510510      ENDIF 
    511511      ! 
    … …  
    513513      ! --------------------------------------- 
    514514      ! 
    515       ALLOCATE( alphan(jcpoc), reminp(jcpoc) ) 
    516       ALLOCATE( alphap(jpi,jpj,jpk,jcpoc) ) 
     515      ALLOCATE( alphan(jcpoc) , reminp(jcpoc) , alphap(jpi,jpj,jpk,jcpoc) ) 
    517516      ! 
    518517      IF (jcpoc > 1) THEN 
    … …  
    551550   END SUBROUTINE p4z_poc_init 
    552551 
     552 
    553553   REAL FUNCTION alngam( xvalue, ifault ) 
    554  
    555 !*****************************************************************************80 
    556 ! 
    557 !! ALNGAM computes the logarithm of the gamma function. 
    558 ! 
    559 !  Modified: 
    560 ! 
    561 !    13 January 2008 
    562 ! 
    563 !  Author: 
    564 ! 
    565 !    Allan Macleod 
    566 !    FORTRAN90 version by John Burkardt 
    567 ! 
    568 !  Reference: 
    569 ! 
    570 !    Allan Macleod, 
    571 !    Algorithm AS 245, 
    572 !    A Robust and Reliable Algorithm for the Logarithm of the Gamma Function, 
    573 !    Applied Statistics, 
    574 !    Volume 38, Number 2, 1989, pages 397-402. 
    575 ! 
    576 !  Parameters: 
    577 ! 
    578 !    Input, real ( kind = 8 ) XVALUE, the argument of the Gamma function. 
    579 ! 
    580 !    Output, integer ( kind = 4 ) IFAULT, error flag. 
    581 !    0, no error occurred. 
    582 !    1, XVALUE is less than or equal to 0. 
    583 !    2, XVALUE is too big. 
    584 ! 
    585 !    Output, real ( kind = 8 ) ALNGAM, the logarithm of the gamma function of X. 
    586 ! 
     554      !*****************************************************************************80 
     555      ! 
     556      !! ALNGAM computes the logarithm of the gamma function. 
     557      ! 
     558      !  Modified:    13 January 2008 
     559      ! 
     560      !  Author  :    Allan Macleod 
     561      !               FORTRAN90 version by John Burkardt 
     562      ! 
     563      !  Reference: 
     564      !    Allan Macleod, Algorithm AS 245, 
     565      !    A Robust and Reliable Algorithm for the Logarithm of the Gamma Function, 
     566      !    Applied Statistics, 
     567      !    Volume 38, Number 2, 1989, pages 397-402. 
     568      ! 
     569      !  Parameters: 
     570      ! 
     571      !    Input, real ( kind = 8 ) XVALUE, the argument of the Gamma function. 
     572      ! 
     573      !    Output, integer ( kind = 4 ) IFAULT, error flag. 
     574      !    0, no error occurred. 
     575      !    1, XVALUE is less than or equal to 0. 
     576      !    2, XVALUE is too big. 
     577      ! 
     578      !    Output, real ( kind = 8 ) ALNGAM, the logarithm of the gamma function of X. 
     579      !*****************************************************************************80 
    587580  implicit none 
    588581 
    … …  
    746739   END FUNCTION alngam 
    747740 
     741 
    748742   REAL FUNCTION gamain( x, p, ifault ) 
    749  
    750743!*****************************************************************************80 
    751744! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90

    r9125 r9169  
    88   !!             3.4  !  2011-05  (O. Aumont, C. Ethe) New parameterization of light limitation 
    99   !!---------------------------------------------------------------------- 
    10    !!   p4z_prod       :   Compute the growth Rate of the two phytoplanktons groups 
    11    !!   p4z_prod_init  :   Initialization of the parameters for growth 
    12    !!   p4z_prod_alloc :   Allocate variables for growth 
     10   !!   p4z_prod       : Compute the growth Rate of the two phytoplanktons groups 
     11   !!   p4z_prod_init  : Initialization of the parameters for growth 
     12   !!   p4z_prod_alloc : Allocate variables for growth 
    1313   !!---------------------------------------------------------------------- 
    14    USE oce_trc         !  shared variables between ocean and passive tracers 
    15    USE trc             !  passive tracers common variables  
    16    USE sms_pisces      !  PISCES Source Minus Sink variables 
    17    USE p4zlim          !  Co-limitations of differents nutrients 
    18    USE prtctl_trc      !  print control for debugging 
    19    USE iom             !  I/O manager 
     14   USE oce_trc         ! shared variables between ocean and passive tracers 
     15   USE trc             ! passive tracers common variables  
     16   USE sms_pisces      ! PISCES Source Minus Sink variables 
     17   USE p4zlim          ! Co-limitations of differents nutrients 
     18   USE prtctl_trc      ! print control for debugging 
     19   USE iom             ! I/O manager 
    2020 
    2121   IMPLICIT NONE 
    … …  
    2626   PUBLIC   p4z_prod_alloc 
    2727 
    28    !! * Shared module variables 
    29    LOGICAL , PUBLIC ::  ln_newprod      !: 
    30    REAL(wp), PUBLIC ::  pislopen         !: 
    31    REAL(wp), PUBLIC ::  pisloped        !: 
    32    REAL(wp), PUBLIC ::  xadap           !: 
    33    REAL(wp), PUBLIC ::  excretn          !: 
    34    REAL(wp), PUBLIC ::  excretd         !: 
    35    REAL(wp), PUBLIC ::  bresp           !: 
    36    REAL(wp), PUBLIC ::  chlcnm          !: 
    37    REAL(wp), PUBLIC ::  chlcdm          !: 
    38    REAL(wp), PUBLIC ::  chlcmin         !: 
    39    REAL(wp), PUBLIC ::  fecnm           !: 
    40    REAL(wp), PUBLIC ::  fecdm           !: 
    41    REAL(wp), PUBLIC ::  grosip          !: 
     28   LOGICAL , PUBLIC ::   ln_newprod   !: 
     29   REAL(wp), PUBLIC ::   pislopen     !: 
     30   REAL(wp), PUBLIC ::   pisloped     !: 
     31   REAL(wp), PUBLIC ::   xadap        !: 
     32   REAL(wp), PUBLIC ::   excretn      !: 
     33   REAL(wp), PUBLIC ::   excretd      !: 
     34   REAL(wp), PUBLIC ::   bresp        !: 
     35   REAL(wp), PUBLIC ::   chlcnm       !: 
     36   REAL(wp), PUBLIC ::   chlcdm       !: 
     37   REAL(wp), PUBLIC ::   chlcmin      !: 
     38   REAL(wp), PUBLIC ::   fecnm        !: 
     39   REAL(wp), PUBLIC ::   fecdm        !: 
     40   REAL(wp), PUBLIC ::   grosip       !: 
    4241 
    4342   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax    !: optimal production = f(temperature) 
    … …  
    4544   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotad   !: proxy of N quota in diatomee 
    4645    
    47    REAL(wp) :: r1_rday                !: 1 / rday 
    48    REAL(wp) :: texcretn               !: 1 - excretn  
    49    REAL(wp) :: texcretd               !: 1 - excretd         
     46   REAL(wp) ::   r1_rday    ! 1 / rday 
     47   REAL(wp) ::   texcretn   ! 1 - excretn  
     48   REAL(wp) ::   texcretd   ! 1 - excretd         
    5049 
    5150   !!---------------------------------------------------------------------- 
    … …  
    6564      !! ** Method  : - ??? 
    6665      !!--------------------------------------------------------------------- 
    67       INTEGER, INTENT(in) :: kt, knt 
     66      INTEGER, INTENT(in) ::   kt, knt   ! 
    6867      ! 
    6968      INTEGER  ::   ji, jj, jk 
    … …  
    475474         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    476475     ENDIF 
    477      ! 
    478      IF( ln_timing )  CALL timing_stop('p4z_prod') 
    479      ! 
     476      ! 
     477      IF( ln_timing )  CALL timing_stop('p4z_prod') 
     478      ! 
    480479   END SUBROUTINE p4z_prod 
    481480 
    … …  
    492491      !! ** input   :   Namelist nampisprod 
    493492      !!---------------------------------------------------------------------- 
    494       INTEGER :: ios                 ! Local integer output status for namelist read 
     493      INTEGER ::   ios   ! Local integer 
    495494      ! 
    496495      NAMELIST/namp4zprod/ pislopen, pisloped, xadap, ln_newprod, bresp, excretn, excretd,  & 
    497496         &                 chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 
    498497      !!---------------------------------------------------------------------- 
    499  
     498      ! 
     499      IF(lwp) THEN                         ! control print 
     500         WRITE(numout,*) 
     501         WRITE(numout,*) 'p4z_prod_init : phytoplankton growth' 
     502         WRITE(numout,*) '~~~~~~~~~~~~~' 
     503      ENDIF 
     504      ! 
    500505      REWIND( numnatp_ref )              ! Namelist nampisprod in reference namelist : Pisces phytoplankton production 
    501506      READ  ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901) 
    502 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in reference namelist', lwp ) 
    503  
     507901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zprod in reference namelist', lwp ) 
    504508      REWIND( numnatp_cfg )              ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production 
    505509      READ  ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 ) 
    506 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp4zprod in configuration namelist', lwp ) 
    507       IF(lwm) WRITE ( numonp, namp4zprod ) 
     510902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zprod in configuration namelist', lwp ) 
     511      IF(lwm) WRITE( numonp, namp4zprod ) 
    508512 
    509513      IF(lwp) THEN                         ! control print 
    510          WRITE(numout,*) ' ' 
    511          WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp4zprod' 
    512          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    513          WRITE(numout,*) '    Enable new parame. of production (T/F)   ln_newprod    =', ln_newprod 
    514          WRITE(numout,*) '    mean Si/C ratio                           grosip       =', grosip 
    515          WRITE(numout,*) '    P-I slope                                 pislopen     =', pislopen 
    516          WRITE(numout,*) '    Acclimation factor to low light           xadap        =', xadap 
    517          WRITE(numout,*) '    excretion ratio of nanophytoplankton      excretn      =', excretn 
    518          WRITE(numout,*) '    excretion ratio of diatoms                excretd      =', excretd 
     514         WRITE(numout,*) '   Namelist : namp4zprod' 
     515         WRITE(numout,*) '      Enable new parame. of production (T/F)   ln_newprod    =', ln_newprod 
     516         WRITE(numout,*) '      mean Si/C ratio                           grosip       =', grosip 
     517         WRITE(numout,*) '      P-I slope                                 pislopen     =', pislopen 
     518         WRITE(numout,*) '      Acclimation factor to low light           xadap        =', xadap 
     519         WRITE(numout,*) '      excretion ratio of nanophytoplankton      excretn      =', excretn 
     520         WRITE(numout,*) '      excretion ratio of diatoms                excretd      =', excretd 
    519521         IF( ln_newprod )  THEN 
    520             WRITE(numout,*) '    basal respiration in phytoplankton        bresp        =', bresp 
    521             WRITE(numout,*) '    Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin 
     522            WRITE(numout,*) '      basal respiration in phytoplankton        bresp        =', bresp 
     523            WRITE(numout,*) '      Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin 
    522524         ENDIF 
    523          WRITE(numout,*) '    P-I slope  for diatoms                    pisloped     =', pisloped 
    524          WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm       =', chlcnm 
    525          WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm       =', chlcdm 
    526          WRITE(numout,*) '    Maximum Fe/C in nanophytoplankton         fecnm        =', fecnm 
    527          WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm        =', fecdm 
     525         WRITE(numout,*) '      P-I slope  for diatoms                    pisloped     =', pisloped 
     526         WRITE(numout,*) '      Minimum Chl/C in nanophytoplankton        chlcnm       =', chlcnm 
     527         WRITE(numout,*) '      Minimum Chl/C in diatoms                  chlcdm       =', chlcdm 
     528         WRITE(numout,*) '      Maximum Fe/C in nanophytoplankton         fecnm        =', fecnm 
     529         WRITE(numout,*) '      Minimum Fe/C in diatoms                   fecdm        =', fecdm 
    528530      ENDIF 
    529531      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90

    r9125 r9169  
    2929   PUBLIC   p4z_rem_alloc 
    3030 
    31    !! * Shared module variables 
    32    REAL(wp), PUBLIC ::  xremikc    !: remineralisation rate of DOC  
    33    REAL(wp), PUBLIC ::  xremikn    !: remineralisation rate of DON  
    34    REAL(wp), PUBLIC ::  xremikp    !: remineralisation rate of DOP  
    35    REAL(wp), PUBLIC ::  xremik     !: remineralisation rate of POC  
    36    REAL(wp), PUBLIC ::  nitrif     !: NH4 nitrification rate  
    37    REAL(wp), PUBLIC ::  xsirem     !: remineralisation rate of POC  
    38    REAL(wp), PUBLIC ::  xsiremlab  !: fast remineralisation rate of POC  
    39    REAL(wp), PUBLIC ::  xsilab     !: fraction of labile biogenic silica  
    40    REAL(wp), PUBLIC ::  feratb     !: Fe/C quota in bacteria 
    41    REAL(wp), PUBLIC ::  xkferb     !: Half-saturation constant for bacteria Fe/C 
    42  
    43    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr     !: denitrification array 
     31   REAL(wp), PUBLIC ::   xremikc    !: remineralisation rate of DOC  
     32   REAL(wp), PUBLIC ::   xremikn    !: remineralisation rate of DON  
     33   REAL(wp), PUBLIC ::   xremikp    !: remineralisation rate of DOP  
     34   REAL(wp), PUBLIC ::   xremik     !: remineralisation rate of POC  
     35   REAL(wp), PUBLIC ::   nitrif     !: NH4 nitrification rate  
     36   REAL(wp), PUBLIC ::   xsirem     !: remineralisation rate of POC  
     37   REAL(wp), PUBLIC ::   xsiremlab  !: fast remineralisation rate of POC  
     38   REAL(wp), PUBLIC ::   xsilab     !: fraction of labile biogenic silica  
     39   REAL(wp), PUBLIC ::   feratb     !: Fe/C quota in bacteria 
     40   REAL(wp), PUBLIC ::   xkferb     !: Half-saturation constant for bacteria Fe/C 
     41 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr   !: denitrification array 
    4443 
    4544   !!---------------------------------------------------------------------- 
    … …  
    303302      INTEGER :: ios                 ! Local integer output status for namelist read 
    304303      !!---------------------------------------------------------------------- 
    305  
     304      ! 
     305      IF(lwp) THEN 
     306         WRITE(numout,*) 
     307         WRITE(numout,*) 'p4z_rem_init : Initialization of remineralization parameters' 
     308         WRITE(numout,*) '~~~~~~~~~~~~' 
     309      ENDIF 
     310      ! 
    306311      REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization 
    307312      READ  ( numnatp_ref, nampisrem, IOSTAT = ios, ERR = 901) 
    308 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisrem in reference namelist', lwp ) 
    309  
     313901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisrem in reference namelist', lwp ) 
    310314      REWIND( numnatp_cfg )              ! Namelist nampisrem in configuration namelist : Pisces remineralization 
    311315      READ  ( numnatp_cfg, nampisrem, IOSTAT = ios, ERR = 902 ) 
    312 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampisrem in configuration namelist', lwp ) 
    313       IF(lwm) WRITE ( numonp, nampisrem ) 
     316902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisrem in configuration namelist', lwp ) 
     317      IF(lwm) WRITE( numonp, nampisrem ) 
    314318 
    315319      IF(lwp) THEN                         ! control print 
    316          WRITE(numout,*) ' ' 
    317          WRITE(numout,*) ' Namelist parameters for remineralization, nampisrem' 
    318          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     320         WRITE(numout,*) '   Namelist parameters for remineralization, nampisrem' 
    319321         IF( ln_p4z ) THEN 
    320             WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik 
     322            WRITE(numout,*) '      remineralization rate of DOC              xremik    =', xremik 
    321323         ELSE 
    322             WRITE(numout,*) '    remineralization rate of DOC              xremikc   =', xremikc 
    323             WRITE(numout,*) '    remineralization rate of DON              xremikn   =', xremikn 
    324             WRITE(numout,*) '    remineralization rate of DOP              xremikp   =', xremikp 
     324            WRITE(numout,*) '      remineralization rate of DOC              xremikc   =', xremikc 
     325            WRITE(numout,*) '      remineralization rate of DON              xremikn   =', xremikn 
     326            WRITE(numout,*) '      remineralization rate of DOP              xremikp   =', xremikp 
    325327         ENDIF 
    326          WRITE(numout,*) '    remineralization rate of Si               xsirem    =', xsirem 
    327          WRITE(numout,*) '    fast remineralization rate of Si          xsiremlab =', xsiremlab 
    328          WRITE(numout,*) '    fraction of labile biogenic silica        xsilab    =', xsilab 
    329          WRITE(numout,*) '    NH4 nitrification rate                    nitrif    =', nitrif 
    330          WRITE(numout,*) '    Bacterial Fe/C ratio                      feratb    =', feratb 
    331          WRITE(numout,*) '    Half-saturation constant for bact. Fe/C   xkferb    =', xkferb 
     328         WRITE(numout,*) '      remineralization rate of Si               xsirem    =', xsirem 
     329         WRITE(numout,*) '      fast remineralization rate of Si          xsiremlab =', xsiremlab 
     330         WRITE(numout,*) '      fraction of labile biogenic silica        xsilab    =', xsilab 
     331         WRITE(numout,*) '      NH4 nitrification rate                    nitrif    =', nitrif 
     332         WRITE(numout,*) '      Bacterial Fe/C ratio                      feratb    =', feratb 
     333         WRITE(numout,*) '      Half-saturation constant for bact. Fe/C   xkferb    =', xkferb 
    332334      ENDIF 
    333335      ! 
    334       denitr  (:,:,:) = 0._wp 
     336      denitr(:,:,:) = 0._wp 
    335337      ! 
    336338   END SUBROUTINE p4z_rem_init 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    r9124 r9169  
    2121   PUBLIC   p4z_sbc_init    
    2222 
    23    LOGICAL , PUBLIC  :: ln_dust     !: boolean for dust input from the atmosphere 
    24    LOGICAL , PUBLIC  :: ln_solub    !: boolean for variable solubility of atmospheric iron 
    25    LOGICAL , PUBLIC  :: ln_river    !: boolean for river input of nutrients 
    26    LOGICAL , PUBLIC  :: ln_ndepo    !: boolean for atmospheric deposition of N 
    27    LOGICAL , PUBLIC  :: ln_ironsed  !: boolean for Fe input from sediments 
    28    LOGICAL , PUBLIC  :: ln_hydrofe  !: boolean for Fe input from hydrothermal vents 
    29    LOGICAL , PUBLIC  :: ln_ironice  !: boolean for Fe input from sea ice 
    30    REAL(wp), PUBLIC  :: sedfeinput  !: Coastal release of Iron 
    31    REAL(wp), PUBLIC  :: dustsolub   !: Solubility of the dust 
    32    REAL(wp), PUBLIC  :: mfrac       !: Mineral Content of the dust 
    33    REAL(wp), PUBLIC  :: icefeinput  !: Iron concentration in sea ice 
    34    REAL(wp), PUBLIC  :: wdust       !: Sinking speed of the dust  
    35    REAL(wp), PUBLIC  :: nitrfix     !: Nitrogen fixation rate    
    36    REAL(wp), PUBLIC  :: diazolight  !: Nitrogen fixation sensitivty to light  
    37    REAL(wp), PUBLIC  :: concfediaz  !: Fe half-saturation Cste for diazotrophs  
    38    REAL(wp)          :: hratio      !: Fe:3He ratio assumed for vent iron supply 
    39    REAL(wp), PUBLIC  :: fep_rats    !: Fep/Fer ratio from sed  sources 
    40    REAL(wp), PUBLIC  :: fep_rath    !: Fep/Fer ratio from hydro sources 
    41    REAL(wp), PUBLIC  :: lgw_rath    !: Weak ligand ratio from hydro sources 
    42  
    43  
    44    LOGICAL , PUBLIC  :: ll_sbc 
    45  
    46    LOGICAL  ::  ll_solub 
     23   LOGICAL , PUBLIC ::   ln_dust      !: boolean for dust input from the atmosphere 
     24   LOGICAL , PUBLIC ::   ln_solub     !: boolean for variable solubility of atmospheric iron 
     25   LOGICAL , PUBLIC ::   ln_river     !: boolean for river input of nutrients 
     26   LOGICAL , PUBLIC ::   ln_ndepo     !: boolean for atmospheric deposition of N 
     27   LOGICAL , PUBLIC ::   ln_ironsed   !: boolean for Fe input from sediments 
     28   LOGICAL , PUBLIC ::   ln_hydrofe   !: boolean for Fe input from hydrothermal vents 
     29   LOGICAL , PUBLIC ::   ln_ironice   !: boolean for Fe input from sea ice 
     30   REAL(wp), PUBLIC ::   sedfeinput   !: Coastal release of Iron 
     31   REAL(wp), PUBLIC ::   dustsolub    !: Solubility of the dust 
     32   REAL(wp), PUBLIC ::   mfrac        !: Mineral Content of the dust 
     33   REAL(wp), PUBLIC ::   icefeinput   !: Iron concentration in sea ice 
     34   REAL(wp), PUBLIC ::   wdust        !: Sinking speed of the dust  
     35   REAL(wp), PUBLIC ::   nitrfix      !: Nitrogen fixation rate    
     36   REAL(wp), PUBLIC ::   diazolight   !: Nitrogen fixation sensitivty to light  
     37   REAL(wp), PUBLIC ::   concfediaz   !: Fe half-saturation Cste for diazotrophs  
     38   REAL(wp)         ::   hratio       !: Fe:3He ratio assumed for vent iron supply 
     39   REAL(wp), PUBLIC ::   fep_rats     !: Fep/Fer ratio from sed  sources 
     40   REAL(wp), PUBLIC ::   fep_rath     !: Fep/Fer ratio from hydro sources 
     41   REAL(wp), PUBLIC ::   lgw_rath     !: Weak ligand ratio from hydro sources 
     42 
     43   LOGICAL , PUBLIC ::   ll_sbc 
     44   LOGICAL          ::   ll_solub 
    4745 
    4846   INTEGER , PARAMETER  :: jpriv  = 7   !: Maximum number of river input fields 
    … …  
    5553   INTEGER , PARAMETER  :: jr_dsi = 7   !: index of dissolved silicate 
    5654 
    57  
    5855   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust 
    59    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_solub      ! structure of input dust 
    60    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_river  ! structure of input riverdic 
     56   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_solub     ! structure of input dust 
     57   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_river     ! structure of input riverdic 
    6158   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ndepo     ! structure of input nitrogen deposition 
    6259   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ironsed   ! structure of input iron from sediment 
    6360   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_hydrofe   ! structure of input iron from hydrothermal vents 
    6461 
    65    INTEGER , PARAMETER :: nbtimes = 365  !: maximum number of times record in a file 
    66    INTEGER  :: ntimes_dust, ntimes_riv, ntimes_ndep       ! number of time steps in a file 
    67    INTEGER  :: ntimes_solub, ntimes_hydro                 ! number of time steps in a file 
    68  
    69    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: dust, solub       !: dust fields 
    70    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdic, rivalk    !: river input fields 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdin, rivdip    !: river input fields 
    72    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdon, rivdop    !: river input fields 
    73    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdoc    !: river input fields 
    74    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdsi    !: river input fields 
    75    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: nitdep    !: atmospheric N deposition  
    76    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ironsed   !: Coastal supply of iron 
    77    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hydrofe   !: Hydrothermal vent supply of iron 
    78  
    79    REAL(wp), PUBLIC :: sumdepsi, rivalkinput, rivdicinput, nitdepinput 
    80    REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput 
     62   INTEGER , PARAMETER ::   nbtimes = 365                          ! maximum number of times record in a file 
     63   INTEGER             ::   ntimes_dust, ntimes_riv, ntimes_ndep   ! number of time steps in a file 
     64   INTEGER             ::   ntimes_solub, ntimes_hydro             ! number of time steps in a file 
     65 
     66   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dust  , solub    !: dust fields 
     67   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rivdic, rivalk   !: river input fields 
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rivdin, rivdip   !: river input fields 
     69   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rivdon, rivdop   !: river input fields 
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rivdoc           !: river input fields 
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rivdsi           !: river input fields 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nitdep           !: atmospheric N deposition  
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ironsed          !: Coastal supply of iron 
     74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hydrofe          !: Hydrothermal vent supply of iron 
     75 
     76   REAL(wp), PUBLIC ::   rivalkinput, rivdicinput, nitdepinput, sumdepsi 
     77   REAL(wp), PUBLIC ::   rivdininput, rivdipinput, rivdsiinput 
    8178 
    8279   !! * Substitutions 
    … …  
    10097      !! 
    10198      !!---------------------------------------------------------------------- 
    102       !! * arguments 
    103       INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    104  
    105       !! * local declarations 
    106       INTEGER  :: ji,jj  
    107       REAL(wp) :: zcoef, zyyss 
     99      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     100      ! 
     101      INTEGER  ::   ji, jj  
     102      REAL(wp) ::   zcoef, zyyss 
    108103      !!--------------------------------------------------------------------- 
    109104      ! 
    110       IF( ln_timing )  CALL timing_start('p4z_sbc') 
     105      IF( ln_timing )   CALL timing_start('p4z_sbc') 
    111106      ! 
    112107      ! Compute dust at nit000 or only if there is more than 1 time record in dust file 
    … …  
    114109         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 
    115110            CALL fld_read( kt, 1, sf_dust ) 
    116             IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN 
    117                dust(:,:) = sf_dust(1)%fnow(:,:,1) 
    118             ELSE 
    119                dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) ) 
     111            IF( nn_ice_tr == -1 .AND. .NOT.ln_ironice ) THEN   ;   dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     112            ELSE                                               ;   dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.-fr_i(:,:) ) 
    120113            ENDIF 
    121114         ENDIF 
    122115      ENDIF 
    123  
     116      ! 
    124117      IF( ll_solub ) THEN 
    125118         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_solub > 1 ) ) THEN 
    … …  
    205198      !! 
    206199      !!---------------------------------------------------------------------- 
    207       ! 
    208200      INTEGER  :: ji, jj, jk, jm, ifpr 
    209201      INTEGER  :: ii0, ii1, ij0, ij1 
    … …  
    224216      TYPE(FLD_N) ::   sn_riverdoc, sn_riverdic, sn_riverdsi   ! informations about the fields to be read 
    225217      TYPE(FLD_N) ::   sn_riverdin, sn_riverdon, sn_riverdip, sn_riverdop 
    226       ! 
     218      !! 
    227219      NAMELIST/nampissbc/cn_dir, sn_dust, sn_solub, sn_riverdic, sn_riverdoc, sn_riverdin, sn_riverdon,     & 
    228220        &                sn_riverdip, sn_riverdop, sn_riverdsi, sn_ndepo, sn_ironsed, sn_hydrofe, & 
    … …  
    232224      !!---------------------------------------------------------------------- 
    233225      ! 
     226      IF(lwp) THEN 
     227         WRITE(numout,*) 
     228         WRITE(numout,*) 'p4z_sbc_init : initialization of the external sources of nutrients ' 
     229         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     230      ENDIF 
    234231      !                            !* set file information 
    235232      REWIND( numnatp_ref )              ! Namelist nampissbc in reference namelist : Pisces external sources of nutrients 
    236233      READ  ( numnatp_ref, nampissbc, IOSTAT = ios, ERR = 901) 
    237 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in reference namelist', lwp ) 
    238  
     234901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampissbc in reference namelist', lwp ) 
    239235      REWIND( numnatp_cfg )              ! Namelist nampissbc in configuration namelist : Pisces external sources of nutrients 
    240236      READ  ( numnatp_cfg, nampissbc, IOSTAT = ios, ERR = 902 ) 
    241 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp ) 
     237902   IF( ios >  0 )  CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp ) 
    242238      IF(lwm) WRITE ( numonp, nampissbc ) 
    243239 
    244       IF ( ( nn_ice_tr >= 0 ) .AND. ln_ironice ) THEN 
     240      IF(lwp) THEN 
     241         WRITE(numout,*) '   Namelist : nampissbc ' 
     242         WRITE(numout,*) '      dust input from the atmosphere           ln_dust     = ', ln_dust 
     243         WRITE(numout,*) '      Variable solubility of iron input        ln_solub    = ', ln_solub 
     244         WRITE(numout,*) '      river input of nutrients                 ln_river    = ', ln_river 
     245         WRITE(numout,*) '      atmospheric deposition of n              ln_ndepo    = ', ln_ndepo 
     246         WRITE(numout,*) '      Fe input from sediments                  ln_ironsed  = ', ln_ironsed 
     247         WRITE(numout,*) '      Fe input from seaice                     ln_ironice  = ', ln_ironice 
     248         WRITE(numout,*) '      fe input from hydrothermal vents         ln_hydrofe  = ', ln_hydrofe 
     249         WRITE(numout,*) '      coastal release of iron                  sedfeinput  = ', sedfeinput 
     250         WRITE(numout,*) '      solubility of the dust                   dustsolub   = ', dustsolub 
     251         WRITE(numout,*) '      Mineral Fe content of the dust           mfrac       = ', mfrac 
     252         WRITE(numout,*) '      Iron concentration in sea ice            icefeinput  = ', icefeinput 
     253         WRITE(numout,*) '      sinking speed of the dust                wdust       = ', wdust 
     254         WRITE(numout,*) '      nitrogen fixation rate                   nitrfix     = ', nitrfix 
     255         WRITE(numout,*) '      nitrogen fixation sensitivty to light    diazolight  = ', diazolight 
     256         WRITE(numout,*) '      Fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz 
     257         WRITE(numout,*) '      Fe to 3He ratio assumed for vent iron supply hratio  = ', hratio 
     258         IF( ln_ligand ) THEN 
     259            WRITE(numout,*) '      Fep/Fer ratio from sed sources            fep_rats   = ', fep_rats 
     260            WRITE(numout,*) '      Fep/Fer ratio from sed hydro sources      fep_rath   = ', fep_rath 
     261            WRITE(numout,*) '      Weak ligand ratio from sed hydro sources  lgw_rath   = ', lgw_rath 
     262         ENDIF 
     263      END IF 
     264 
     265      IF( nn_ice_tr >= 0 .AND. ln_ironice ) THEN 
    245266         IF(lwp) THEN 
    246             WRITE(numout,*) ' ln_ironice incompatible with nn_ice_tr = ', nn_ice_tr 
    247             WRITE(numout,*) ' Specify your sea ice iron concentration in nampisice instead ' 
    248             WRITE(numout,*) ' ln_ironice is forced to .FALSE. ' 
    249             ln_ironice = .FALSE. 
    250          ENDIF 
    251       ENDIF 
    252  
    253       IF(lwp) THEN 
    254          WRITE(numout,*) ' ' 
    255          WRITE(numout,*) ' namelist : nampissbc ' 
    256          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ ' 
    257          WRITE(numout,*) '    dust input from the atmosphere           ln_dust     = ', ln_dust 
    258          WRITE(numout,*) '    Variable solubility of iron input        ln_solub    = ', ln_solub 
    259          WRITE(numout,*) '    river input of nutrients                 ln_river    = ', ln_river 
    260          WRITE(numout,*) '    atmospheric deposition of n              ln_ndepo    = ', ln_ndepo 
    261          WRITE(numout,*) '    Fe input from sediments                  ln_ironsed  = ', ln_ironsed 
    262          WRITE(numout,*) '    Fe input from seaice                     ln_ironice  = ', ln_ironice 
    263          WRITE(numout,*) '    fe input from hydrothermal vents         ln_hydrofe  = ', ln_hydrofe 
    264          WRITE(numout,*) '    coastal release of iron                  sedfeinput  = ', sedfeinput 
    265          WRITE(numout,*) '    solubility of the dust                   dustsolub   = ', dustsolub 
    266          WRITE(numout,*) '    Mineral Fe content of the dust           mfrac       = ', mfrac 
    267          WRITE(numout,*) '    Iron concentration in sea ice            icefeinput  = ', icefeinput 
    268          WRITE(numout,*) '    sinking speed of the dust                wdust       = ', wdust 
    269          WRITE(numout,*) '    nitrogen fixation rate                   nitrfix     = ', nitrfix 
    270          WRITE(numout,*) '    nitrogen fixation sensitivty to light    diazolight  = ', diazolight 
    271          WRITE(numout,*) '    fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz 
    272          WRITE(numout,*) '    Fe to 3He ratio assumed for vent iron supply hratio  = ', hratio 
    273          IF( ln_ligand ) THEN 
    274             WRITE(numout,*) '    Fep/Fer ratio from sed sources            fep_rats   = ', fep_rats 
    275             WRITE(numout,*) '    Fep/Fer ratio from sed hydro sources      fep_rath   = ', fep_rath 
    276             WRITE(numout,*) '    Weak ligand ratio from sed hydro sources  lgw_rath   = ', lgw_rath 
    277          ENDIF 
    278       END IF 
    279  
    280       IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN  ;  ll_sbc = .TRUE. 
    281       ELSE                                            ;  ll_sbc = .FALSE. 
    282       ENDIF 
    283  
    284       IF( ln_dust .AND. ln_solub ) THEN               ;  ll_solub = .TRUE. 
    285       ELSE                                            ;  ll_solub = .FALSE. 
     267            WRITE(numout,*) '   ==>>>   ln_ironice incompatible with nn_ice_tr = ', nn_ice_tr 
     268            WRITE(numout,*) '           Specify your sea ice iron concentration in nampisice instead ' 
     269            WRITE(numout,*) '           ln_ironice is forced to .FALSE. ' 
     270         ENDIF 
     271         ln_ironice = .FALSE. 
     272      ENDIF 
     273 
     274      IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN   ;   ll_sbc = .TRUE. 
     275      ELSE                                             ;   ll_sbc = .FALSE. 
     276      ENDIF 
     277 
     278      IF( ln_dust .AND. ln_solub ) THEN                ;   ll_solub = .TRUE. 
     279      ELSE                                             ;   ll_solub = .FALSE. 
    286280      ENDIF 
    287281 
    … …  
    322316            DO jm = 1, ntimes_dust 
    323317               sumdepsi = sumdepsi + glob_sum( zdust(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) * ztimes_dust ) 
    324             ENDDO 
     318            END DO 
    325319            sumdepsi = sumdepsi / ( nyear_len(1) * rday ) * 12. * 8.8 * 0.075 * mfrac / 28.1  
    326320            DEALLOCATE( zdust) 
    … …  
    335329      IF( ll_solub ) THEN 
    336330         ! 
    337          IF(lwp) WRITE(numout,*) '    initialize variable solubility of Fe ' 
    338          IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 
     331         IF(lwp) WRITE(numout,*) 
     332         IF(lwp) WRITE(numout,*) '   ==>>>   ll_solub=T , initialize variable solubility of Fe ' 
    339333         ! 
    340334         ALLOCATE( solub(jpi,jpj) )    ! allocation 
    … …  
    356350      IF( ln_river ) THEN 
    357351         ! 
    358          slf_river(jr_dic) = sn_riverdic  ;  slf_river(jr_doc) = sn_riverdoc  ;  slf_river(jr_din) = sn_riverdin  
    359          slf_river(jr_don) = sn_riverdon  ;  slf_river(jr_dip) = sn_riverdip  ;  slf_river(jr_dop) = sn_riverdop 
     352         slf_river(jr_dic) = sn_riverdic   ;   slf_river(jr_doc) = sn_riverdoc   ;   slf_river(jr_din) = sn_riverdin  
     353         slf_river(jr_don) = sn_riverdon   ;   slf_river(jr_dip) = sn_riverdip   ;   slf_river(jr_dop) = sn_riverdop 
    360354         slf_river(jr_dsi) = sn_riverdsi   
    361355         ! 
    … …  
    363357         IF( ln_p5z )  ALLOCATE( rivdon(jpi,jpj), rivdop(jpi,jpj), rivdoc(jpi,jpj) ) 
    364358         ! 
    365          ALLOCATE( sf_river(jpriv), rivinput(jpriv), STAT=ierr1 )           !* allocate and fill sf_river (forcing structure) with sn_river_ 
    366          rivinput(:) = 0.0 
     359         ALLOCATE( sf_river(jpriv), rivinput(jpriv), STAT=ierr1 )    !* allocate and fill sf_river (forcing structure) with sn_river_ 
     360         rivinput(:) = 0._wp 
    367361 
    368362         IF( ierr1 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_irver structure' ) 
    … …  
    409403      IF( ln_ndepo ) THEN 
    410404         ! 
    411          IF(lwp) WRITE(numout,*) '    initialize the nutrient input by dust from ndeposition.orca.nc' 
    412          IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     405         IF(lwp) WRITE(numout,*) 
     406         IF(lwp) WRITE(numout,*) '   ==>>>   ln_ndepo=T , initialize the nutrient input by dust from NetCDF file' 
    413407         ! 
    414408         ALLOCATE( nitdep(jpi,jpj) )    ! allocation 
    … …  
    446440      IF( ln_ironsed ) THEN      
    447441         ! 
    448          IF(lwp) WRITE(numout,*) '    computation of an island mask to enhance coastal supply of iron' 
    449          IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     442         IF(lwp) WRITE(numout,*) 
     443         IF(lwp) WRITE(numout,*) '   ==>>>   ln_ironsed=T , computation of an island mask to enhance coastal supply of iron' 
    450444         ! 
    451445         ALLOCATE( ironsed(jpi,jpj,jpk) )    ! allocation 
    … …  
    458452         ik50 = 5        !  last level where depth less than 50 m 
    459453         DO jk = jpkm1, 1, -1 
    460             IF( gdept_1d(jk) > 50. )  ik50 = jk - 1 
     454            IF( gdept_1d(jk) > 50. )   ik50 = jk - 1 
    461455         END DO 
    462          IF (lwp) WRITE(numout,*) 
    463          IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1) 
    464          IF (lwp) WRITE(numout,*) 
     456         IF(lwp) WRITE(numout,*) 
     457         IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1) 
    465458         DO jk = 1, ik50 
    466459            DO jj = 2, jpjm1 
    … …  
    499492      IF( ln_hydrofe ) THEN 
    500493         ! 
    501          IF(lwp) WRITE(numout,*) '    Input of iron from hydrothermal vents ' 
    502          IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     494         IF(lwp) WRITE(numout,*) 
     495         IF(lwp) WRITE(numout,*) '   ==>>>   ln_hydrofe=T , Input of iron from hydrothermal vents' 
    503496         ! 
    504497         ALLOCATE( hydrofe(jpi,jpj,jpk) )    ! allocation 
    … …  
    521514         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    522515         WRITE(numout,*) '    N Supply   : ', rivdininput*rno3*1E3/1E12*14.,' TgN/yr' 
    523          WRITE(numout,*) '    Si Supply  : ', rivdsiinput*1E3/1E12*28.1,' TgSi/yr' 
     516         WRITE(numout,*) '    Si Supply  : ', rivdsiinput*1E3/1E12*28.1    ,' TgSi/yr' 
    524517         WRITE(numout,*) '    P Supply   : ', rivdipinput*1E3*po4r/1E12*31.,' TgP/yr' 
    525          WRITE(numout,*) '    Alk Supply : ', rivalkinput*1E3/1E12,' Teq/yr' 
    526          WRITE(numout,*) '    DIC Supply : ', rivdicinput*1E3*12./1E12,'TgC/yr' 
     518         WRITE(numout,*) '    Alk Supply : ', rivalkinput*1E3/1E12         ,' Teq/yr' 
     519         WRITE(numout,*) '    DIC Supply : ', rivdicinput*1E3*12./1E12     ,' TgC/yr' 
    527520         WRITE(numout,*)  
    528521         WRITE(numout,*) '    Total input of elements from atmospheric supply' 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90

    r9125 r9169  
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!---------------------------------------------------------------------- 
    9    !!   p4zsms         : Time loop of passive tracers sms 
     9   !!   p4z_sms        : Time loop of passive tracers sms 
    1010   !!---------------------------------------------------------------------- 
    11    USE oce_trc         !  shared variables between ocean and passive tracers 
    12    USE trc             !  passive tracers common variables  
    13    USE trcdta 
    14    USE sms_pisces      !  PISCES Source Minus Sink variables 
    15    USE p4zbio          !  Biological model 
    16    USE p4zche          !  Chemical model 
    17    USE p4zlys          !  Calcite saturation 
    18    USE p4zflx          !  Gas exchange 
    19    USE p4zsbc          !  External source of nutrients 
    20    USE p4zsed          !  Sedimentation 
    21    USE p4zint          !  time interpolation 
    22    USE p4zrem          !  remineralisation 
    23    USE iom             !  I/O manager 
    24    USE trd_oce         !  Ocean trends variables 
    25    USE trdtrc          !  TOP trends variables 
    26    USE sedmodel        !  Sediment model 
    27    USE prtctl_trc      !  print control for debugging 
     11   USE oce_trc         ! shared variables between ocean and passive tracers 
     12   USE trc             ! passive tracers common variables  
     13   USE trcdta          !  
     14   USE sms_pisces      ! PISCES Source Minus Sink variables 
     15   USE p4zbio          ! Biological model 
     16   USE p4zche          ! Chemical model 
     17   USE p4zlys          ! Calcite saturation 
     18   USE p4zflx          ! Gas exchange 
     19   USE p4zsbc          ! External source of nutrients 
     20   USE p4zsed          ! Sedimentation 
     21   USE p4zint          ! time interpolation 
     22   USE p4zrem          ! remineralisation 
     23   USE iom             ! I/O manager 
     24   USE trd_oce         ! Ocean trends variables 
     25   USE trdtrc          ! TOP trends variables 
     26   USE sedmodel        ! Sediment model 
     27   USE prtctl_trc      ! print control for debugging 
    2828 
    2929   IMPLICIT NONE 
    … …  
    3333   PUBLIC   p4z_sms        ! called in p4zsms.F90 
    3434 
    35    REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget 
    36    REAL(wp) :: xfact1, xfact2, xfact3 
    37    INTEGER ::  numco2, numnut, numnit  !: logical unit for co2 budget 
    38  
    39    !!* Array used to indicate negative tracer values 
    40    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     !: ??? 
     35   INTEGER ::    numco2, numnut, numnit      ! logical unit for co2 budget 
     36   REAL(wp) ::   alkbudget, no3budget, silbudget, ferbudget, po4budget 
     37   REAL(wp) ::   xfact1, xfact2, xfact3 
     38 
     39   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     ! Array used to indicate negative tracer values 
    4140 
    4241   !!---------------------------------------------------------------------- 
    … …  
    4544   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4645   !!---------------------------------------------------------------------- 
    47  
    4846CONTAINS 
    4947 
    … …  
    197195      NAMELIST/nampismass/ ln_check_mass 
    198196      !!---------------------------------------------------------------------- 
     197      ! 
     198      IF(lwp) THEN 
     199         WRITE(numout,*) 
     200         WRITE(numout,*) 'p4z_sms_init : PISCES initialization' 
     201         WRITE(numout,*) '~~~~~~~~~~~~' 
     202      ENDIF 
    199203 
    200204      REWIND( numnatp_ref )              ! Namelist nampisbio in reference namelist : Pisces variables 
    201205      READ  ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901) 
    202 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist', lwp ) 
    203  
     206901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisbio in reference namelist', lwp ) 
    204207      REWIND( numnatp_cfg )              ! Namelist nampisbio in configuration namelist : Pisces variables 
    205208      READ  ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 ) 
    206 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist', lwp ) 
    207       IF(lwm) WRITE ( numonp, nampisbio ) 
    208  
     209902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisbio in configuration namelist', lwp ) 
     210      IF(lwm) WRITE( numonp, nampisbio ) 
     211      ! 
    209212      IF(lwp) THEN                         ! control print 
    210          WRITE(numout,*) ' Namelist : nampisbio' 
    211          WRITE(numout,*) '    frequence pour la biologie                nrdttrc    =', nrdttrc 
    212          WRITE(numout,*) '    POC sinking speed                         wsbio      =', wsbio 
    213          WRITE(numout,*) '    half saturation constant for mortality    xkmort     =', xkmort  
     213         WRITE(numout,*) '   Namelist : nampisbio' 
     214         WRITE(numout,*) '      frequency for the biology                 nrdttrc     =', nrdttrc 
     215         WRITE(numout,*) '      POC sinking speed                         wsbio       =', wsbio 
     216         WRITE(numout,*) '      half saturation constant for mortality    xkmort      =', xkmort  
    214217         IF( ln_p5z ) THEN 
    215             WRITE(numout,*) '    N/C in zooplankton                        no3rat3    =', no3rat3 
    216             WRITE(numout,*) '    P/C in zooplankton                        po4rat3    =', po4rat3 
    217          ENDIF 
    218          WRITE(numout,*) '    Fe/C in zooplankton                       ferat3     =', ferat3 
    219          WRITE(numout,*) '    Big particles sinking speed               wsbio2     =', wsbio2 
    220          WRITE(numout,*) '    Big particles maximum sinking speed       wsbio2max  =', wsbio2max 
    221          WRITE(numout,*) '    Big particles sinking speed length scale  wsbio2scale =', wsbio2scale 
    222          WRITE(numout,*) '    Maximum number of iterations for POC      niter1max =', niter1max 
    223          WRITE(numout,*) '    Maximum number of iterations for GOC      niter2max =', niter2max 
     218            WRITE(numout,*) '      N/C in zooplankton                        no3rat3     =', no3rat3 
     219            WRITE(numout,*) '      P/C in zooplankton                        po4rat3     =', po4rat3 
     220         ENDIF 
     221         WRITE(numout,*) '      Fe/C in zooplankton                       ferat3      =', ferat3 
     222         WRITE(numout,*) '      Big particles sinking speed               wsbio2      =', wsbio2 
     223         WRITE(numout,*) '      Big particles maximum sinking speed       wsbio2max   =', wsbio2max 
     224         WRITE(numout,*) '      Big particles sinking speed length scale  wsbio2scale =', wsbio2scale 
     225         WRITE(numout,*) '      Maximum number of iterations for POC      niter1max  =', niter1max 
     226         WRITE(numout,*) '      Maximum number of iterations for GOC      niter2max  =', niter2max 
    224227         IF( ln_ligand ) THEN 
    225             WRITE(numout,*) '    FeP sinking speed                             wfep   =', wfep 
     228            WRITE(numout,*) '      FeP sinking speed                              wfep   =', wfep 
    226229            IF( ln_p4z ) THEN 
    227               WRITE(numout,*) '    Phyto ligand production per unit doc          ldocp  =', ldocp 
    228               WRITE(numout,*) '    Zoo ligand production per unit doc            ldocz  =', ldocz 
    229               WRITE(numout,*) '    Proportional loss of ligands due to Fe uptake lthet  =', lthet 
     230               WRITE(numout,*) '      Phyto ligand production per unit doc           ldocp  =', ldocp 
     231               WRITE(numout,*) '      Zoo ligand production per unit doc             ldocz  =', ldocz 
     232               WRITE(numout,*) '      Proportional loss of ligands due to Fe uptake lthet  =', lthet 
    230233            ENDIF 
    231234         ENDIF 
    … …  
    235238      REWIND( numnatp_ref )              ! Namelist nampisdmp in reference namelist : Pisces damping 
    236239      READ  ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905) 
    237 905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist', lwp ) 
    238  
     240905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisdmp in reference namelist', lwp ) 
    239241      REWIND( numnatp_cfg )              ! Namelist nampisdmp in configuration namelist : Pisces damping 
    240242      READ  ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 ) 
    241 906   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist', lwp ) 
    242       IF(lwm) WRITE ( numonp, nampisdmp ) 
    243  
     243906   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisdmp in configuration namelist', lwp ) 
     244      IF(lwm) WRITE( numonp, nampisdmp ) 
     245      ! 
    244246      IF(lwp) THEN                         ! control print 
    245247         WRITE(numout,*) 
    246          WRITE(numout,*) ' Namelist : nampisdmp' 
    247          WRITE(numout,*) '    Relaxation of tracer to glodap mean value             ln_pisdmp      =', ln_pisdmp 
    248          WRITE(numout,*) '    Frequency of Relaxation                               nn_pisdmp      =', nn_pisdmp 
    249          WRITE(numout,*) ' ' 
     248         WRITE(numout,*) '   Namelist : nampisdmp --- relaxation to GLODAP' 
     249         WRITE(numout,*) '      Relaxation of tracer to glodap mean value   ln_pisdmp =', ln_pisdmp 
     250         WRITE(numout,*) '      Frequency of Relaxation                     nn_pisdmp =', nn_pisdmp 
    250251      ENDIF 
    251252 
    252253      REWIND( numnatp_ref )              ! Namelist nampismass in reference namelist : Pisces mass conservation check 
    253254      READ  ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907) 
    254 907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist', lwp ) 
    255  
     255907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampismass in reference namelist', lwp ) 
    256256      REWIND( numnatp_cfg )              ! Namelist nampismass in configuration namelist : Pisces mass conservation check  
    257257      READ  ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 ) 
    258 908   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist', lwp ) 
    259       IF(lwm) WRITE ( numonp, nampismass ) 
     258908   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampismass in configuration namelist', lwp ) 
     259      IF(lwm) WRITE( numonp, nampismass ) 
    260260 
    261261      IF(lwp) THEN                         ! control print 
    262          WRITE(numout,*) ' ' 
    263          WRITE(numout,*) ' Namelist parameter for mass conservation checking' 
    264          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    265          WRITE(numout,*) '    Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass 
     262         WRITE(numout,*) 
     263         WRITE(numout,*) '   Namelist : nampismass  --- mass conservation checking' 
     264         WRITE(numout,*) '      Flag to check mass conservation of NO3/Si/TALK   ln_check_mass = ', ln_check_mass 
    266265      ENDIF 
    267266      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r7753 r9169  
    3737      !! ** Purpose :   Initialisation of the PISCES biochemical model 
    3838      !!---------------------------------------------------------------------- 
    39  
    4039      ! 
    4140      CALL trc_nam_pisces 
    … …  
    4645 
    4746   END SUBROUTINE trc_ini_pisces 
     47 
    4848 
    4949   SUBROUTINE p4z_ini 
    … …  
    5353      !! ** Purpose :   Initialisation of the PISCES biochemical model 
    5454      !!---------------------------------------------------------------------- 
    55       ! 
    5655      USE p4zsms          ! Main P4Z routine 
    5756      USE p4zche          !  Chemical model 
    … …  
    7675      USE p5zmeso         !  Sources and sinks of mesozooplankton 
    7776      USE p5zmort         !  Mortality terms for phytoplankton 
    78  
    79       ! 
    80       REAL(wp), SAVE :: sco2   =  2.312e-3_wp 
    81       REAL(wp), SAVE :: alka0  =  2.426e-3_wp 
    82       REAL(wp), SAVE :: oxyg0  =  177.6e-6_wp  
    83       REAL(wp), SAVE :: po4    =  2.165e-6_wp  
    84       REAL(wp), SAVE :: bioma0 =  1.000e-8_wp   
    85       REAL(wp), SAVE :: silic1 =  91.51e-6_wp   
    86       REAL(wp), SAVE :: no3    =  30.9e-6_wp * 7.625_wp 
     77      ! 
     78      REAL(wp), SAVE ::   sco2   =  2.312e-3_wp 
     79      REAL(wp), SAVE ::   alka0  =  2.426e-3_wp 
     80      REAL(wp), SAVE ::   oxyg0  =  177.6e-6_wp  
     81      REAL(wp), SAVE ::   po4    =  2.165e-6_wp  
     82      REAL(wp), SAVE ::   bioma0 =  1.000e-8_wp   
     83      REAL(wp), SAVE ::   silic1 =  91.51e-6_wp   
     84      REAL(wp), SAVE ::   no3    =  30.9e-6_wp * 7.625_wp 
    8785      ! 
    8886      INTEGER  ::  ji, jj, jk, jn, ierr 
    … …  
    9088      REAL(wp) ::  ztmas, ztmas1 
    9189      CHARACTER(len = 20)  ::  cltra 
    92  
    93       !!---------------------------------------------------------------------- 
    94  
     90      !!---------------------------------------------------------------------- 
     91      ! 
    9592      IF(lwp) THEN 
    9693         WRITE(numout,*) 
    9794         IF( ln_p4z ) THEN  
    98             WRITE(numout,*) ' p4z_ini :   PISCES biochemical model initialisation' 
     95            WRITE(numout,*) 'p4z_ini :   PISCES biochemical model initialisation' 
     96            WRITE(numout,*) '~~~~~~~' 
    9997         ELSE 
    100             WRITE(numout,*) ' p5z_ini :   PISCES biochemical model initialisation' 
    101             WRITE(numout,*) '             With variable stoichiometry' 
     98            WRITE(numout,*) 'p5z_ini :   PISCES biochemical model initialisation' 
     99            WRITE(numout,*) '~~~~~~~     With variable stoichiometry' 
    102100         ENDIF 
    103          WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    104101      ENDIF 
    105102      ! 
    … …  
    170167        IF( cltra == 'LGW'      )   jplgw = jn      !: Weak ligands 
    171168        IF( cltra == 'LFe'      )   jpfep = jn      !: Fe nanoparticle 
    172       ENDDO 
     169      END DO 
    173170 
    174171      CALL p4z_sms_init       !  Maint routine 
    175       !                                            ! Time-step 
     172      ! 
    176173 
    177174      ! Set biological ratios 
    … …  
    275272 
    276273      IF(lwp) WRITE(numout,*)  
    277       IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 
     274      IF(lwp) WRITE(numout,*) '   ==>>>   Initialization of PISCES tracers done' 
    278275      IF(lwp) WRITE(numout,*)  
    279276      ! 
    280277   END SUBROUTINE p4z_ini 
     278 
    281279 
    282280   SUBROUTINE p2z_ini 
    … …  
    298296      IF(lwp) WRITE(numout,*) 
    299297      IF(lwp) WRITE(numout,*) ' p2z_ini :   LOBSTER biochemical model initialisation' 
    300       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     298      IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
    301299 
    302300      ierr =        sms_pisces_alloc()           
    … …  
    346344      ! 
    347345      IF(lwp) WRITE(numout,*)  
    348       IF(lwp) WRITE(numout,*) 'Initialization of LOBSTER tracers done' 
     346      IF(lwp) WRITE(numout,*) '   ==>>>   Initialization of LOBSTER tracers done' 
    349347      IF(lwp) WRITE(numout,*)  
    350348      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90

    r9124 r9169  
    99   !!             2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.pisces.h90 
    1010   !!---------------------------------------------------------------------- 
    11    !! trc_nam_pisces       : PISCES model namelist read 
     11   !! trc_nam_pisces   : PISCES model namelist read 
    1212   !!---------------------------------------------------------------------- 
    1313   USE oce_trc         ! Ocean variables 
    … …  
    4040      !!---------------------------------------------------------------------- 
    4141      INTEGER :: jl, jn 
    42       INTEGER :: ios, ioptio                 ! Local integer output status for namelist read 
    43       CHARACTER(LEN=20)   ::   clname 
     42      INTEGER :: ios, ioptio         ! Local integer 
     43      CHARACTER(LEN=20)::   clname 
    4444      !! 
    4545      NAMELIST/nampismod/ln_p2z, ln_p4z, ln_p5z, ln_ligand 
    … …  
    4949      clname = 'namelist_pisces' 
    5050 
    51       IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read PISCES namelist' 
    52       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     51      IF(lwp) WRITE(numout,*) 'trc_nam_pisces : read PISCES namelist' 
     52      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 
    5353      CALL ctl_opn( numnatp_ref, TRIM( clname )//'_ref', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    5454      CALL ctl_opn( numnatp_cfg, TRIM( clname )//'_cfg', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    5555      IF(lwm) CALL ctl_opn( numonp     , 'output.namelist.pis' , 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    5656      ! 
    57  
    5857      REWIND( numnatp_ref )              ! Namelist nampisbio in reference namelist : Pisces variables 
    5958      READ  ( numnatp_ref, nampismod, IOSTAT = ios, ERR = 901) 
    60 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in reference namelist', lwp ) 
    61  
     59901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampismod in reference namelist', lwp ) 
    6260      REWIND( numnatp_cfg )              ! Namelist nampisbio in configuration namelist : Pisces variables 
    6361      READ  ( numnatp_cfg, nampismod, IOSTAT = ios, ERR = 902 ) 
    64 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in configuration namelist', lwp ) 
    65       IF(lwm) WRITE ( numonp, nampismod ) 
    66  
    67      IF(lwp) THEN                  ! control print 
    68          WRITE(numout,*) ' ' 
    69          WRITE(numout,*) ' Flag to use LOBSTER model            ln_p2z    = ', ln_p2z 
    70          WRITE(numout,*) ' Flag to use PISCES standard  model   ln_p4z    = ', ln_p4z 
    71          WRITE(numout,*) ' Flag to use PISCES quota     model   ln_p5z    = ', ln_p5z 
    72          WRITE(numout,*) ' Flag to ligand                       ln_ligand = ', ln_ligand 
    73          WRITE(numout,*) ' ' 
     62902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampismod in configuration namelist', lwp ) 
     63      IF(lwm) WRITE( numonp, nampismod ) 
     64      ! 
     65      IF(lwp) THEN                  ! control print 
     66         WRITE(numout,*) '   Namelist : nampismod ' 
     67         WRITE(numout,*) '      Flag to use LOBSTER model            ln_p2z    = ', ln_p2z 
     68         WRITE(numout,*) '      Flag to use PISCES standard model    ln_p4z    = ', ln_p4z 
     69         WRITE(numout,*) '      Flag to use PISCES quota    model    ln_p5z    = ', ln_p5z 
     70         WRITE(numout,*) '      Flag to ligand                       ln_ligand = ', ln_ligand 
    7471      ENDIF 
    75  
     72      ! 
    7673      IF(lwp) THEN                         ! control print 
    77          WRITE(numout,*) ' ' 
    78          IF( ln_p5z    )  WRITE(numout,*) '  PISCES QUOTA model is used' 
    79          IF( ln_p4z    )  WRITE(numout,*) '  PISCES STANDARD model is used' 
    80          IF( ln_p2z    )  WRITE(numout,*) '  LOBSTER model is used' 
    81          IF( ln_ligand )  WRITE(numout,*) '  Compute remineralization/dissolution of organic ligands' 
    82          WRITE(numout,*) ' ' 
     74         WRITE(numout,*) 
     75         IF( ln_p5z    )  WRITE(numout,*) '   ==>>>   PISCES QUOTA model is used' 
     76         IF( ln_p4z    )  WRITE(numout,*) '   ==>>>   PISCES STANDARD model is used' 
     77         IF( ln_p2z    )  WRITE(numout,*) '   ==>>>   LOBSTER model is used' 
     78         IF( ln_ligand )  WRITE(numout,*) '   ==>>>   Compute remineralization/dissolution of organic ligands' 
    8379      ENDIF 
    8480     

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r9019 r9169  
    153153      !!              passive tracer advection schemes and set nadv 
    154154      !!---------------------------------------------------------------------- 
    155       INTEGER ::   ioptio 
    156       INTEGER ::  ios                 ! Local integer output status for namelist read 
     155      INTEGER ::   ioptio, ios   ! Local integer 
    157156      !! 
    158157      NAMELIST/namtrc_adv/ ln_trcadv_NONE,                       &   ! No advection 
    … …  
    167166      REWIND( numnat_ref )                   !  namtrc_adv in reference namelist  
    168167      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 
    169 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 
    170       ! 
     168901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 
    171169      REWIND( numnat_cfg )                   ! namtrc_adv in configuration namelist 
    172170      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 
    173 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp ) 
     171902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp ) 
    174172      IF(lwm) WRITE ( numont, namtrc_adv ) 
    175173      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r9125 r9169  
    2020   USE trcdta 
    2121   USE tradmp 
    22    USE prtctl_trc      ! Print control for debbuging 
    2322   USE trdtra 
    2423   USE trd_oce 
     24   ! 
    2525   USE iom 
     26   USE prtctl_trc      ! Print control for debbuging 
    2627 
    2728   IMPLICIT NONE 
    … …  
    3334   PUBLIC trc_dmp_ini     
    3435 
    35    INTEGER , PUBLIC ::   nn_zdmp_tr    ! = 0/1/2 flag for damping in the mixed layer 
    36    CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr    !File containing restoration coefficient 
     36   INTEGER            , PUBLIC ::   nn_zdmp_tr    !: = 0/1/2 flag for damping in the mixed layer 
     37   CHARACTER(LEN=200) , PUBLIC ::   cn_resto_tr   !: File containing restoration coefficient 
    3738 
    3839   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1) 
    3940 
    40    INTEGER, PARAMETER           ::   npncts   = 8        ! number of closed sea 
    41    INTEGER, DIMENSION(npncts)   ::   nctsi1, nctsj1      ! south-west closed sea limits (i,j) 
    42    INTEGER, DIMENSION(npncts)   ::   nctsi2, nctsj2      ! north-east closed sea limits (i,j) 
     41   INTEGER, PARAMETER         ::   npncts = 8       ! number of closed sea 
     42   INTEGER, DIMENSION(npncts) ::   nctsi1, nctsj1   ! south-west closed sea limits (i,j) 
     43   INTEGER, DIMENSION(npncts) ::   nctsi2, nctsj2   ! north-east closed sea limits (i,j) 
    4344 
    4445   !! * Substitutions 
    … …  
    182183      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 
    183184      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 
    184 909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp ) 
    185  
     185909   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp ) 
    186186      REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping 
    187187      READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910) 
    188 910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp ) 
     188910   IF( ios >  0 )  CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp ) 
    189189      IF(lwm) WRITE ( numont, namtrc_dmp ) 
    190190 
    … …  
    194194         WRITE(numout,*) '~~~~~~~' 
    195195         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter' 
    196          WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)' 
    197          WRITE(numout,*) '      Restoration coeff file    cn_resto_tr = ', cn_resto_tr 
     196         WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr  = ', nn_zdmp_tr, '(zoom: forced to 0)' 
     197         WRITE(numout,*) '      Restoration coeff file         cn_resto_tr = ', cn_resto_tr 
    198198      ENDIF 
    199199      !                          ! Allocate arrays 
    … …  
    201201      ! 
    202202      SELECT CASE ( nn_zdmp_tr ) 
    203       CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
    204       CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
    205       CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
     203      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '      ===>>   tracer damping throughout the water column' 
     204      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '      ===>>   no tracer damping in the turbocline (avt > 5 cm2/s)' 
     205      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '      ===>>   no tracer damping in the mixed layer' 
    206206      CASE DEFAULT 
    207207         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr 
    … …  
    210210 
    211211      IF( .NOT.lk_c1d ) THEN 
    212          IF( .NOT. ln_tradmp )   & 
    213             &   CALL ctl_stop( 'passive trace damping need ln_tradmp to compute damping coef.' ) 
     212         IF( .NOT.ln_tradmp )   & 
     213            &   CALL ctl_stop( 'passive tracer damping need ln_tradmp to compute damping coef.' ) 
    214214         ! 
    215215         !                          ! Read damping coefficients from file 
    … …  
    241241      INTEGER :: isrow                                      ! local index 
    242242      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace 
    243  
    244243      !!---------------------------------------------------------------------- 
    245244 
    … …  
    260259            isrow = 332 - jpjglo 
    261260            ! 
    262                                                         ! Caspian Sea 
    263             nctsi1(1)   = 333  ; nctsj1(1)   = 243 - isrow 
     261            nctsi1(1)   = 333  ; nctsj1(1)   = 243 - isrow   ! Caspian Sea 
    264262            nctsi2(1)   = 342  ; nctsj2(1)   = 274 - isrow 
    265             !                                           ! Lake Superior 
    266             nctsi1(2)   = 198  ; nctsj1(2)   = 258 - isrow 
     263            !                                         
     264            nctsi1(2)   = 198  ; nctsj1(2)   = 258 - isrow   ! Lake Superior 
    267265            nctsi2(2)   = 204  ; nctsj2(2)   = 262 - isrow 
    268             !                                           ! Lake Michigan 
    269             nctsi1(3)   = 201  ; nctsj1(3)   = 250 - isrow 
     266            !                                          
     267            nctsi1(3)   = 201  ; nctsj1(3)   = 250 - isrow   ! Lake Michigan 
    270268            nctsi2(3)   = 203  ; nctsj2(3)   = 256 - isrow 
    271             !                                           ! Lake Huron 
    272             nctsi1(4)   = 204  ; nctsj1(4)   = 252 - isrow 
     269            !                                         
     270            nctsi1(4)   = 204  ; nctsj1(4)   = 252 - isrow   ! Lake Huron 
    273271            nctsi2(4)   = 209  ; nctsj2(4)   = 256 - isrow 
    274             !                                           ! Lake Erie 
    275             nctsi1(5)   = 206  ; nctsj1(5)   = 249 - isrow 
     272            !                                         
     273            nctsi1(5)   = 206  ; nctsj1(5)   = 249 - isrow   ! Lake Erie 
    276274            nctsi2(5)   = 209  ; nctsj2(5)   = 251 - isrow 
    277             !                                           ! Lake Ontario 
    278             nctsi1(6)   = 210  ; nctsj1(6)   = 252 - isrow 
     275            !                                         
     276            nctsi1(6)   = 210  ; nctsj1(6)   = 252 - isrow   ! Lake Ontario 
    279277            nctsi2(6)   = 212  ; nctsj2(6)   = 252 - isrow 
    280             !                                           ! Victoria Lake 
    281             nctsi1(7)   = 321  ; nctsj1(7)   = 180 - isrow 
     278            !                                         
     279            nctsi1(7)   = 321  ; nctsj1(7)   = 180 - isrow   ! Victoria Lake 
    282280            nctsi2(7)   = 322  ; nctsj2(7)   = 189 - isrow 
    283             !                                           ! Baltic Sea 
    284             nctsi1(8)   = 297  ; nctsj1(8)   = 270 - isrow 
     281            !                                         
     282            nctsi1(8)   = 297  ; nctsj1(8)   = 270 - isrow   ! Baltic Sea 
    285283            nctsi2(8)   = 308  ; nctsj2(8)   = 293 - isrow 
    286284            !                                         
    … …  
    288286            CASE ( 2 )                                  !  ORCA_R2 configuration 
    289287               !                                        ! ======================= 
    290                !                                            ! Caspian Sea 
    291                nctsi1(1)   =  11  ;  nctsj1(1)   = 103 
     288               !                                       
     289               nctsi1(1)   =  11  ;  nctsj1(1)   = 103       ! Caspian Sea 
    292290               nctsi2(1)   =  17  ;  nctsj2(1)   = 112 
    293                !                                            ! Great North American Lakes 
    294                nctsi1(2)   =  97  ;  nctsj1(2)   = 107 
     291               !                                      
     292               nctsi1(2)   =  97  ;  nctsj1(2)   = 107       ! Great North American Lakes 
    295293               nctsi2(2)   = 103  ;  nctsj2(2)   = 111 
    296                !                                            ! Black Sea 1 : west part of the Black Sea 
    297                nctsi1(3)   = 174  ;  nctsj1(3)   = 107 
     294               !                                      
     295               nctsi1(3)   = 174  ;  nctsj1(3)   = 107       ! Black Sea 1 : west part of the Black Sea 
    298296               nctsi2(3)   = 181  ;  nctsj2(3)   = 112 
    299               !                                            ! Black Sea 2 : est part of the Black Sea 
    300                nctsi1(4)   =   2  ;  nctsj1(4)   = 107 
     297              !                                       
     298               nctsi1(4)   =   2  ;  nctsj1(4)   = 107      ! Black Sea 2 : est part of the Black Sea 
    301299               nctsi2(4)   =   6  ;  nctsj2(4)   = 112 
    302                !                                            ! Baltic Sea 
    303                nctsi1(5)   =  145 ;  nctsj1(5)   = 116 
     300               !                                      
     301               nctsi1(5)   =  145 ;  nctsj1(5)   = 116       ! Baltic Sea 
    304302               nctsi2(5)   =  150 ;  nctsj2(5)   = 126 
    305303               !                                        ! ======================= 
    306304            CASE ( 4 )                                  !  ORCA_R4 configuration 
    307305               !                                        ! ======================= 
    308                !                                            ! Caspian Sea 
    309                nctsi1(1)   =  4  ;  nctsj1(1)   = 53 
     306               !                                    
     307               nctsi1(1)   =  4  ;  nctsj1(1)   = 53         ! Caspian Sea 
    310308               nctsi2(1)   =  4  ;  nctsj2(1)   = 56 
    311                !                                            ! Great North American Lakes 
    312                nctsi1(2)   = 49  ;  nctsj1(2)   = 55 
     309               !                                    
     310               nctsi1(2)   = 49  ;  nctsj1(2)   = 55         ! Great North American Lakes 
    313311               nctsi2(2)   = 51  ;  nctsj2(2)   = 56 
    314                !                                            ! Black Sea 
    315                nctsi1(3)   = 88  ;  nctsj1(3)   = 55 
     312               !                                    
     313               nctsi1(3)   = 88  ;  nctsj1(3)   = 55         ! Black Sea 
    316314               nctsi2(3)   = 91  ;  nctsj2(3)   = 56 
    317                !                                            ! Baltic Sea 
    318                nctsi1(4)   = 75  ;  nctsj1(4)   = 59 
     315               !                                    
     316               nctsi1(4)   = 75  ;  nctsj1(4)   = 59         ! Baltic Sea 
    319317               nctsi2(4)   = 76  ;  nctsj2(4)   = 61 
    320318               !                                        ! ======================= 
    321319            CASE ( 025 )                                ! ORCA_R025 configuration 
    322320               !                                        ! ======================= 
    323                                                      ! Caspian + Aral sea 
    324                nctsi1(1)   = 1330 ; nctsj1(1)   = 645 
     321               !                                    
     322               nctsi1(1)   = 1330 ; nctsj1(1)   = 645        ! Caspian + Aral sea 
    325323               nctsi2(1)   = 1400 ; nctsj2(1)   = 795 
    326                !                                        ! Azov Sea 
    327                nctsi1(2)   = 1284 ; nctsj1(2)   = 722 
     324               !                                     
     325               nctsi1(2)   = 1284 ; nctsj1(2)   = 722        ! Azov Sea 
    328326               nctsi2(2)   = 1304 ; nctsj2(2)   = 747 
    329327               ! 
    … …  
    332330         ENDIF 
    333331         ! 
    334  
    335332         ! convert the position in local domain indices 
    336333         ! -------------------------------------------- 
    … …  
    338335            nctsi1(jc)   = mi0( nctsi1(jc) ) 
    339336            nctsj1(jc)   = mj0( nctsj1(jc) ) 
    340  
     337            ! 
    341338            nctsi2(jc)   = mi1( nctsi2(jc) ) 
    342339            nctsj2(jc)   = mj1( nctsj2(jc) ) 
    … …  
    364361                            trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) 
    365362                            trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
    366                          ENDDO 
    367                       ENDDO 
    368                    ENDDO 
    369                 ENDDO 
     363                         END DO 
     364                      END DO 
     365                   END DO 
     366                END DO 
    370367             ENDIF 
    371           ENDDO 
     368          END DO 
    372369          DEALLOCATE( ztrcdta ) 
    373370      ENDIF 
    374371      ! 
    375372   END SUBROUTINE trc_dmp_clo 
    376  
    377373  
    378374#else 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r9125 r9169  
    152152      REWIND( numnat_cfg )             !  namtrc_ldf in configuration namelist  
    153153      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 
    154 904   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 
     154904   IF( ios > 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 
    155155      IF(lwm) WRITE ( numont, namtrc_ldf ) 
    156156      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r9125 r9169  
    3232   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3333   !!---------------------------------------------------------------------- 
    34     
    3534CONTAINS 
    3635 
    … …  
    5049      !!                (the total CFC content is not strictly preserved) 
    5150      !!---------------------------------------------------------------------- 
    52       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index       
     51      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     52      ! 
    5353      CHARACTER (len=22) :: charout 
    5454      !!---------------------------------------------------------------------- 
    … …  
    5656      IF( ln_timing )   CALL timing_start('trc_rad') 
    5757      ! 
    58       IF( kt == nittrc000 ) THEN 
    59          IF(lwp) WRITE(numout,*) 
    60          IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' 
    61          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    62       ENDIF 
    63  
    64       IF( ln_age     )   CALL trc_rad_sms( kt, trb, trn, jp_age , jp_age               )  !  AGE 
     58      IF( ln_age     )   CALL trc_rad_sms( kt, trb, trn, jp_age , jp_age                )  !  AGE 
    6559      IF( ll_cfc     )   CALL trc_rad_sms( kt, trb, trn, jp_cfc0, jp_cfc1               )  !  CFC model 
    66       IF( ln_c14     )   CALL trc_rad_sms( kt, trb, trn, jp_c14 , jp_c14               )  !  C14 
     60      IF( ln_c14     )   CALL trc_rad_sms( kt, trb, trn, jp_c14 , jp_c14                )  !  C14 
    6761      IF( ln_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0, jp_pcs1, cpreserv='Y' )  !  PISCES model 
    6862      IF( ln_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0, jp_myt1               )  !  MY_TRC model 
    69  
    7063      ! 
    7164      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
    … …  
    7972   END SUBROUTINE trc_rad 
    8073 
     74 
    8175   SUBROUTINE trc_rad_ini 
    8276      !!--------------------------------------------------------------------- 
    8377      !!                  ***  ROUTINE trc _rad_ini *** 
    8478      !! 
    85       !! ** Purpose : read  namelist options  
    86       !!---------------------------------------------------------------------- 
    87       INTEGER ::  ios                 ! Local integer output status for namelist read 
     79      !! ** Purpose :   read  namelist options  
     80      !!---------------------------------------------------------------------- 
     81      INTEGER ::   ios   ! Local integer output status for namelist read 
     82      !! 
    8883      NAMELIST/namtrc_rad/ ln_trcrad 
    8984      !!---------------------------------------------------------------------- 
    90  
    9185      ! 
    9286      REWIND( numnat_ref )              ! namtrc_rad in reference namelist  
    9387      READ  ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907) 
    94 907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp ) 
    95  
     88907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp ) 
    9689      REWIND( numnat_cfg )              ! namtrc_rad in configuration namelist  
    9790      READ  ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 ) 
    98 908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp ) 
    99       IF(lwm) WRITE ( numont, namtrc_rad ) 
     91908   IF( ios > 0 )  CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp ) 
     92      IF(lwm) WRITE( numont, namtrc_rad ) 
    10093 
    10194      IF(lwp) THEN                     !   ! Control print 
    10295         WRITE(numout,*) 
     96         WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' 
     97         WRITE(numout,*) '~~~~~~~ ' 
    10398         WRITE(numout,*) '   Namelist namtrc_rad : treatment of negative concentrations' 
    104          WRITE(numout,*) '      correct artificially negative concen. or not ln_trcrad = ', ln_trcrad 
     99         WRITE(numout,*) '      correct artificially negative concen. or not   ln_trcrad = ', ln_trcrad 
     100         WRITE(numout,*) 
     101         IF( ln_trcrad ) THEN   ;   WRITE(numout,*) '      ===>>   ensure the global tracer conservation' 
     102         ELSE                   ;   WRITE(numout,*) '      ===>>   NO strict global tracer conservation'       
     103         ENDIF 
    105104      ENDIF 
    106105      ! 
    107106   END SUBROUTINE trc_rad_ini 
     107 
    108108 
    109109   SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) 
    … …  
    123123      !!                  (the total content of concentration is not strictly preserved) 
    124124      !!-------------------------------------------------------------------------------- 
    125       !! Arguments 
    126       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    127       INTEGER  , INTENT( in ) ::  & 
    128          jp_sms0, &       !: First index of the passive tracer model 
    129          jp_sms1          !: Last  index of  the passive tracer model 
    130  
    131       REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT( inout )  :: & 
    132          ptrb, ptrn       !: before and now traceur concentration 
    133  
    134       CHARACTER( len = 1) , INTENT(in), OPTIONAL  :: & 
    135          cpreserv          !: flag to preserve content or not 
    136        
    137       ! Local declarations 
    138       INTEGER  :: ji, jj, jk, jn     ! dummy loop indices 
    139       REAL(wp) :: ztrcorb, ztrmasb   ! temporary scalars 
    140       REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         " 
     125      INTEGER                                , INTENT(in   ) ::   kt                 ! ocean time-step index 
     126      INTEGER                                , INTENT(in   ) ::   jp_sms0, jp_sms1   ! First & last index of the passive tracer model 
     127      REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT(inout) ::   ptrb    , ptrn     ! before and now traceur concentration 
     128      CHARACTER( len = 1), OPTIONAL          , INTENT(in   ) ::   cpreserv           ! flag to preserve content or not 
     129      ! 
     130      INTEGER ::   ji, jj, jk, jn     ! dummy loop indices 
     131      LOGICAL ::   lldebug = .FALSE.           ! local logical 
     132      REAL(wp)::   ztrcorb, ztrmasb, zs2rdt    ! temporary scalars 
     133      REAL(wp)::   zcoef  , ztrcorn, ztrmasn   !    -         - 
    141134      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrtrdb, ztrtrdn   ! workspace arrays 
    142       REAL(wp) :: zs2rdt 
    143       LOGICAL ::   lldebug = .FALSE. 
    144       !!---------------------------------------------------------------------- 
    145  
    146   
    147       IF( l_trdtrc )  ALLOCATE( ztrtrdb(jpi,jpj,jpk), ztrtrdn(jpi,jpj,jpk) ) 
    148        
    149       IF( PRESENT( cpreserv )  ) THEN   !  total tracer concentration is preserved  
    150        
     135      !!---------------------------------------------------------------------- 
     136      ! 
     137      IF( l_trdtrc )   ALLOCATE( ztrtrdb(jpi,jpj,jpk), ztrtrdn(jpi,jpj,jpk) ) 
     138      ! 
     139      IF( PRESENT( cpreserv )  ) THEN     !==  total tracer concentration is preserved  ==! 
     140         ! 
    151141         DO jn = jp_sms0, jp_sms1 
    152             !                                                        ! =========== 
    153             ztrcorb = 0.e0   ;   ztrmasb = 0.e0 
    154             ztrcorn = 0.e0   ;   ztrmasn = 0.e0 
    155  
     142            ! 
     143            ztrcorb = 0._wp   ;   ztrmasb = 0._wp 
     144            ztrcorn = 0._wp   ;   ztrmasn = 0._wp 
     145            ! 
    156146            IF( l_trdtrc ) THEN 
    157147               ztrtrdb(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation 
    … …  
    161151            ztrcorb = glob_sum( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 
    162152            ztrcorn = glob_sum( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 
    163  
     153            ! 
    164154            ztrmasb = glob_sum( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 
    165155            ztrmasn = glob_sum( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 
    166  
     156            ! 
    167157            IF( ztrcorb /= 0 ) THEN 
    168158               zcoef = 1. + ztrcorb / ztrmasb 
    … …  
    172162               END DO 
    173163            ENDIF 
    174  
     164            ! 
    175165            IF( ztrcorn /= 0 ) THEN 
    176166               zcoef = 1. + ztrcorn / ztrmasn 
    … …  
    190180              ! 
    191181            ENDIF 
    192  
     182            ! 
    193183         END DO 
    194184         ! 
    195          ! 
    196       ELSE  ! total CFC content is not strictly preserved 
    197  
     185      ELSE                                !==  total CFC content is NOT strictly preserved  ==! 
     186         ! 
    198187         DO jn = jp_sms0, jp_sms1   
    199  
    200            IF( l_trdtrc ) THEN 
    201               ztrtrdb(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation 
    202               ztrtrdn(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation 
    203            ENDIF 
    204  
     188            ! 
     189            IF( l_trdtrc ) THEN 
     190               ztrtrdb(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation 
     191               ztrtrdn(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation 
     192            ENDIF 
     193            ! 
    205194            DO jk = 1, jpkm1 
    206195               DO jj = 1, jpj 
    … …  
    211200               END DO 
    212201            END DO 
    213           
     202            ! 
    214203            IF( l_trdtrc ) THEN 
    215204               ! 
    … …  
    222211            ENDIF 
    223212            ! 
    224          ENDDO 
    225  
     213         END DO 
     214         ! 
    226215      ENDIF 
    227  
     216      ! 
    228217      IF( l_trdtrc )  DEALLOCATE( ztrtrdb, ztrtrdn ) 
    229  
     218      ! 
    230219   END SUBROUTINE trc_rad_sms 
     220 
    231221#else 
    232222   !!---------------------------------------------------------------------- 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r9124 r9169  
    6060      !!              - allocates passive tracer BC data structure  
    6161      !!---------------------------------------------------------------------- 
    62       INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
     62      INTEGER,INTENT(in) :: ntrc                           ! number of tracers 
     63      ! 
    6364      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices 
    6465      INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers 
    … …  
    6869      ! 
    6970      CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc 
    70  
    7171      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i  ! local array of namelist informations on the fields to read 
    7272      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc    ! open 
    … …  
    8383      ! 
    8484      IF( lwp ) THEN 
    85          WRITE(numout,*) ' ' 
     85         WRITE(numout,*) 
    8686         WRITE(numout,*) 'trc_bc_ini : Tracers Boundary Conditions (BC)' 
    8787         WRITE(numout,*) '~~~~~~~~~~~ ' 
    8888      ENDIF 
    8989      !  Initialisation and local array allocation 
    90       ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0   
     90      ierr0 = 0   ;   ierr1 = 0   ;   ierr2 = 0   ;   ierr3 = 0   
    9191      ALLOCATE( slf_i(ntrc), STAT=ierr0 ) 
    9292      IF( ierr0 > 0 ) THEN 
    … …  
    9999         CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indobc' )   ;   RETURN 
    100100      ENDIF 
    101       nb_trcobc      = 0 
     101      nb_trcobc       = 0 
    102102      n_trc_indobc(:) = 0 
    103103      ! 
    … …  
    106106         CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indsbc' )   ;   RETURN 
    107107      ENDIF 
    108       nb_trcsbc      = 0 
     108      nb_trcsbc       = 0 
    109109      n_trc_indsbc(:) = 0 
    110110      ! 
    … …  
    113113         CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indcbc' )   ;   RETURN 
    114114      ENDIF 
    115       nb_trccbc      = 0 
     115      nb_trccbc       = 0 
    116116      n_trc_indcbc(:) = 0 
    117117      ! 
    … …  
    119119      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
    120120      READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901) 
    121 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in reference namelist', lwp ) 
    122  
     121901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bc in reference namelist', lwp ) 
    123122      REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 
    124123      READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 
    125 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 
     124902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 
    126125      IF(lwm) WRITE ( numont, namtrc_bc ) 
    127126 
    … …  
    129128         REWIND( numnat_ref )              ! Namelist namtrc_bdy in reference namelist : Passive tracer data structure 
    130129         READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 
    131 903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 
     130903      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 
    132131 
    133132         REWIND( numnat_cfg )              ! Namelist namtrc_bdy in configuration namelist : Passive tracer data structure 
    134133         READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 
    135 904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 
     134904      IF( ios >  0 )  CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 
    136135         IF(lwm) WRITE ( numont, namtrc_bdy ) 
    137136       
    … …  
    140139            DO ib = 1, nb_bdy 
    141140               ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml) 
    142                IF ( ln_trc_obc(jn) ) THEN 
    143                   trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) 
    144                ELSE 
    145                   trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 
     141               IF ( ln_trc_obc(jn) ) THEN   ;   trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc     (ib) ) 
     142               ELSE                         ;   trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 
    146143               ENDIF 
    147144               ! set damping use in BDY data structure 
    148145               trcdta_bdy(jn,ib)%dmp = .false. 
    149                IF(nn_trcdmp_bdy(ib) .EQ. 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true. 
    150                IF(nn_trcdmp_bdy(ib) .EQ. 2 ) trcdta_bdy(jn,ib)%dmp = .true. 
    151                IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE. 0 )  & 
    152                    & CALL ctl_stop( 'Use FRS OR relaxation' ) 
    153                IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2)            & 
    154                    & CALL ctl_stop( 'Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 
    155             ENDDO 
    156          ENDDO 
     146               IF(nn_trcdmp_bdy(ib) == 1 .AND. ln_trc_obc(jn) )  trcdta_bdy(jn,ib)%dmp = .true. 
     147               IF(nn_trcdmp_bdy(ib) == 2                      )  trcdta_bdy(jn,ib)%dmp = .true. 
     148               IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) /= 0 )  & 
     149                   & CALL ctl_stop( 'trc_bc_ini: Use FRS OR relaxation' ) 
     150               IF(  .NOT.( 0 < nn_trcdmp_bdy(ib)  .AND.  nn_trcdmp_bdy(ib) <= 2 )  )   & 
     151                   & CALL ctl_stop( 'trc_bc_ini: Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 
     152            END DO 
     153         END DO 
    157154      ELSE 
    158155         ! Force all tracers OBC to false if bdy not used 
    … …  
    163160      DO jn = 1, ntrc 
    164161         IF( ln_trc_obc(jn) ) THEN 
    165              nb_trcobc       = nb_trcobc + 1  ; n_trc_indobc(jn) = nb_trcobc 
     162             nb_trcobc       = nb_trcobc + 1   ;  n_trc_indobc(jn) = nb_trcobc 
    166163         ENDIF 
    167164         IF( ln_trc_sbc(jn) ) THEN 
    168              nb_trcsbc       = nb_trcsbc + 1  ; n_trc_indsbc(jn) = nb_trcsbc 
     165             nb_trcsbc       = nb_trcsbc + 1   ;  n_trc_indsbc(jn) = nb_trcsbc 
    169166         ENDIF 
    170167         IF( ln_trc_cbc(jn) ) THEN 
    171              nb_trccbc       = nb_trccbc + 1  ; n_trc_indcbc(jn) = nb_trccbc 
    172          ENDIF 
    173       ENDDO 
     168             nb_trccbc       = nb_trccbc + 1   ;  n_trc_indcbc(jn) = nb_trccbc 
     169         ENDIF 
     170      END DO 
    174171 
    175172      ! Print summmary of Boundary Conditions 
    176173      IF( lwp ) THEN 
    177          WRITE(numout,*) ' ' 
     174         WRITE(numout,*) 
    178175         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc 
    179176         IF ( nb_trcsbc > 0 ) THEN 
    … …  
    181178            DO jn = 1, ntrc 
    182179               IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn) 
    183             ENDDO 
     180            END DO 
    184181         ENDIF 
    185182         WRITE(numout,'(2a)') '   SURFACE BC data repository : ', TRIM(cn_dir_sbc) 
    186  
    187          WRITE(numout,*) ' ' 
     183         ! 
     184         WRITE(numout,*) 
    188185         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with COASTAL BCs data:', nb_trccbc 
    189186         IF( nb_trccbc > 0 ) THEN 
    … …  
    191188            DO jn = 1, ntrc 
    192189               IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn) 
    193             ENDDO 
     190            END DO 
    194191         ENDIF 
    195192         WRITE(numout,'(2a)') '   COASTAL BC data repository : ', TRIM(cn_dir_cbc) 
    196          IF( .NOT.ln_rnf .OR. .NOT.ln_linssh ) ln_rnf_ctl = .FALSE. 
     193         IF( .NOT.ln_rnf .OR. .NOT.ln_linssh )   ln_rnf_ctl = .FALSE. 
    197194         IF( ln_rnf_ctl )  WRITE(numout,'(a)') & 
    198195              &            ' -> Remove runoff dilution effect on tracers with absent river load (ln_rnf_ctl = .TRUE.)' 
    199          WRITE(numout,*) ' ' 
     196         WRITE(numout,*) 
    200197         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with OPEN BCs data:', nb_trcobc 
    201198 
    … …  
    207204               IF ( .NOT. ln_trc_obc(jn) )  WRITE(numout, 9002) jn, 'Set data to IC and use default condition'       , & 
    208205                    &                                           (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 
    209             ENDDO 
     206            END DO 
    210207            WRITE(numout,*) ' ' 
    211208            DO ib = 1, nb_bdy 
    212                 IF(nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) '   Boundary ', ib, & 
    213                      &                                          ' -> NO damping of tracers' 
    214                 IF(nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) '   Boundary ', ib, & 
    215                      &                                          ' -> damping ONLY for tracers with external data provided' 
    216                 IF(nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) '   Boundary ', ib, & 
    217                      &                                          ' -> damping of ALL tracers' 
    218                 IF(nn_trcdmp_bdy(ib) .GT. 0) THEN 
     209               IF(nn_trcdmp_bdy(ib) == 0) WRITE(numout,9003) '   Boundary ', ib, & 
     210                  &                                          ' -> NO damping of tracers' 
     211               IF(nn_trcdmp_bdy(ib) == 1) WRITE(numout,9003) '   Boundary ', ib, & 
     212                  &                                          ' -> damping ONLY for tracers with external data provided' 
     213               IF(nn_trcdmp_bdy(ib) == 2) WRITE(numout,9003) '   Boundary ', ib, & 
     214                  &                                          ' -> damping of ALL tracers' 
     215               IF(nn_trcdmp_bdy(ib) > 0) THEN 
    219216                   WRITE(numout,9003) '     USE damping parameters from nambdy for boundary ', ib,' : ' 
    220                    WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp(ib),' days' 
     217                   WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp    (ib),' days' 
    221218                   WRITE(numout,'(a,f10.2,a)') '     - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 
    222                 ENDIF 
    223             ENDDO 
    224          ENDIF 
    225  
     219               ENDIF 
     220            END DO 
     221         ENDIF 
     222         ! 
    226223         WRITE(numout,'(2a)') '   OPEN BC data repository : ', TRIM(cn_dir_obc) 
    227224      ENDIF 
    … …  
    2292269002  FORMAT(2x,i5, 3x, a41, 3x, 10a13) 
    2302279003  FORMAT(a, i5, a) 
    231  
     228      ! 
    232229      ! 
    233230      ! OPEN Lateral boundary conditions 
    … …  
    237234            CALL ctl_stop( 'trc_bc_ini: unable to allocate sf_trcobc structure' )   ;   RETURN 
    238235         ENDIF 
    239  
     236         ! 
    240237         igrd = 1                       ! Everything is at T-points here 
    241  
     238         ! 
    242239         DO jn = 1, ntrc 
    243240            DO ib = 1, nb_bdy 
    244  
     241               ! 
    245242               nblen = idx_bdy(ib)%nblen(igrd) 
    246  
    247                IF ( ln_trc_obc(jn) ) THEN 
    248                ! Initialise from external data 
     243               ! 
     244               IF( ln_trc_obc(jn) ) THEN     !* Initialise from external data *! 
    249245                  jl = n_trc_indobc(jn) 
    250246                  slf_i(jl)    = sn_trcobc(jn) 
    251247                  rf_trofac(jl) = rn_trofac(jn) 
    252                                                ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk)   , STAT=ierr2 ) 
    253                   IF( sn_trcobc(jn)%ln_tint )  ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 
     248                                                ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk)   , STAT=ierr2 ) 
     249                  IF( sn_trcobc(jn)%ln_tint )   ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 
    254250                  IF( ierr2 + ierr3 > 0 ) THEN 
    255251                    CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
    … …  
    260256                  nbmap_ptr(jl)%ptr => idx_bdy(ib)%nbmap(:,igrd) 
    261257                  nbmap_ptr(jl)%ll_unstruc = ln_coords_file(igrd) 
    262                ELSE 
    263                ! Initialise obc arrays from initial conditions 
     258                  ! 
     259               ELSE                          !* Initialise obc arrays from initial conditions *! 
    264260                  ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) ) 
    265261                  DO ibd = 1, nblen 
    … …  
    272268                  trcdta_bdy(jn,ib)%rn_fac = 1._wp 
    273269               ENDIF 
    274             ENDDO 
    275          ENDDO 
    276  
     270            END DO 
     271         END DO 
     272         ! 
    277273         CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_ini', 'Passive tracer OBC data', 'namtrc_bc' ) 
    278274      ENDIF 
    … …  
    297293            ENDIF 
    298294            !    
    299          ENDDO 
     295         END DO 
    300296         !                         ! fill sf_trcsbc with slf_i and control print 
    301297         CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_ini', 'Passive tracer SBC data', 'namtrc_bc' ) 
    … …  
    322318            ENDIF 
    323319            !    
    324          ENDDO 
     320         END DO 
    325321         !                         ! fill sf_trccbc with slf_i and control print 
    326322         CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_ini', 'Passive tracer CBC data', 'namtrc_bc' ) 
    … …  
    341337      !! ** Method  :  1) Read BC inputs and update data structures using fldread 
    342338      !!               2) Apply Boundary Conditions to tracers 
    343       !!               
    344339      !!---------------------------------------------------------------------- 
    345340      USE fldread 
    346341      !!       
    347       INTEGER, INTENT( in ) ::   kt              ! ocean time-step index 
    348       INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
     342      INTEGER, INTENT(in)           ::   kt    ! ocean time-step index 
     343      INTEGER, INTENT(in), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
    349344      !! 
    350345      INTEGER  :: ji, jj, jk, jn, jl             ! Loop index 
    … …  
    357352         WRITE(numout,*) 
    358353         WRITE(numout,*) 'trc_bc : Surface boundary conditions for passive tracers.' 
    359          WRITE(numout,*) '~~~~~~~~~~~ ' 
     354         WRITE(numout,*) '~~~~~~~ ' 
    360355      ENDIF 
    361356 
    362357      ! 1. Update Boundary conditions data 
    363       IF ( PRESENT(jit) ) THEN  
    364  
     358      IF( PRESENT(jit) ) THEN  
     359         ! 
    365360         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
    366361         IF( nb_trcobc > 0 ) THEN 
    367362           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
    368            CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kit=jit, kt_offset=+1) 
    369          ENDIF 
    370  
     363           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kit=jit, kt_offset=+1) 
     364         ENDIF 
     365         ! 
    371366         ! SURFACE boundary conditions 
    372367         IF( nb_trcsbc > 0 ) THEN 
    373368           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
    374            CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 
    375          ENDIF 
    376  
     369           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 
     370         ENDIF 
     371         ! 
    377372         ! COASTAL boundary conditions 
    378373         IF( nb_trccbc > 0 ) THEN 
    379374           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
    380            CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 
    381          ENDIF 
    382  
     375           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 
     376         ENDIF 
     377         ! 
    383378      ELSE 
    384  
     379         ! 
    385380         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
    386381         IF( nb_trcobc > 0 ) THEN 
    387382           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
    388            CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kt_offset=+1) 
    389          ENDIF 
    390  
     383           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kt_offset=+1) 
     384         ENDIF 
     385         ! 
    391386         ! SURFACE boundary conditions 
    392387         IF( nb_trcsbc > 0 ) THEN 
    393388           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
    394            CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc) 
    395          ENDIF 
    396  
     389           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc ) 
     390         ENDIF 
     391         ! 
    397392         ! COASTAL boundary conditions 
    398393         IF( nb_trccbc > 0 ) THEN 
    399394           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
    400            CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc) 
    401          ENDIF 
    402  
     395           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc ) 
     396         ENDIF 
     397         ! 
    403398      ENDIF 
    404399 
    … …  
    408403         ! 
    409404         ! Remove river dilution for tracers with absent river load 
    410          IF ( ln_rnf_ctl .AND. .NOT. ln_trc_cbc(jn) ) THEN 
     405         IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN 
    411406            DO jj = 2, jpj 
    412407               DO ji = fs_2, fs_jpim1 
    … …  
    414409                     zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 
    415410                     tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)  + (trn(ji,jj,jk,jn) * zrnf) 
    416                   ENDDO 
    417                ENDDO 
    418             ENDDO 
    419          ENDIF 
    420            
     411                  END DO 
     412               END DO 
     413            END DO 
     414         ENDIF 
     415         ! 
    421416         ! OPEN boundary conditions: trcbdy is called in trcnxt ! 
    422  
     417         ! 
    423418         ! SURFACE boundary conditions 
    424          IF (ln_trc_sbc(jn)) THEN 
     419         IF( ln_trc_sbc(jn) ) THEN 
    425420            jl = n_trc_indsbc(jn) 
    426421            DO jj = 2, jpj 
    … …  
    430425               END DO 
    431426            END DO 
    432          END IF 
    433  
     427         ENDIF 
     428         ! 
    434429         ! COASTAL boundary conditions 
    435          IF ( ln_rnf .AND. ln_trc_cbc(jn)) THEN 
     430         IF( ln_rnf .AND. ln_trc_cbc(jn) ) THEN 
    436431            jl = n_trc_indcbc(jn) 
    437432            DO jj = 2, jpj 
    … …  
    440435                     zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_bc_time )  
    441436                     tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 
    442                   ENDDO 
     437                  END DO 
    443438               END DO 
    444439            END DO 
    445          END IF 
     440         ENDIF 
    446441         !                                                       ! =========== 
    447442      END DO                                                     ! tracer loop 
    … …  
    460455      WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', kt 
    461456   END SUBROUTINE trc_bc_ini 
    462  
    463457   SUBROUTINE trc_bc( kt )        ! Empty routine 
    464458      WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r9124 r9169  
    5555      !!              - allocates passive tracer data structure  
    5656      !!---------------------------------------------------------------------- 
    57       ! 
    58       INTEGER,INTENT(IN) :: ntrc                             ! number of tracers 
    59       INTEGER            :: jl, jn                           ! dummy loop indices 
    60       INTEGER            :: ierr0, ierr1, ierr2, ierr3       ! temporary integers 
    61       INTEGER            :: ios                              ! Local integer output status for namelist read 
    62       CHARACTER(len=100) :: clndta, clntrc 
    63       REAL(wp)           :: zfact 
    64       ! 
    65       CHARACTER(len=100)            :: cn_dir 
     57      INTEGER,INTENT(in) ::   ntrc   ! number of tracers 
     58      ! 
     59      INTEGER ::   jl, jn                            ! dummy loop indices 
     60      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3   ! local integers 
     61      REAL(wp) ::   zfact 
     62      CHARACTER(len=100) ::   clndta, clntrc 
     63      ! 
     64      CHARACTER(len=100) ::   cn_dir 
    6665      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read 
    6766      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcdta 
    … …  
    7271      ! 
    7372      IF( lwp ) THEN 
    74          WRITE(numout,*) ' ' 
    75          WRITE(numout,*) '  trc_dta_ini : Tracers Initial Conditions (IC)' 
    76          WRITE(numout,*) '  ~~~~~~~~~~~ ' 
     73         WRITE(numout,*) 
     74         WRITE(numout,*) 'trc_dta_ini : Tracers Initial Conditions (IC)' 
     75         WRITE(numout,*) '~~~~~~~~~~~ ' 
    7776      ENDIF 
    7877      ! 
    … …  
    9190             n_trc_index(jn) = nb_trcdta  
    9291         ENDIF 
    93       ENDDO 
     92      END DO 
    9493      ! 
    9594      ntra = MAX( 1, nb_trcdta )   ! To avoid compilation error with bounds checking 
    9695      IF(lwp) THEN 
    97          WRITE(numout,*) ' ' 
    98          WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra 
    99          WRITE(numout,*) ' ' 
     96         WRITE(numout,*) 
     97         WRITE(numout,*) '   number of passive tracers to be initialize by data :', ntra 
    10098      ENDIF 
    10199      ! 
    102100      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data 
    103101      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 
    104 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist', lwp ) 
    105  
     102901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist', lwp ) 
    106103      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 
    107104      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 
    108 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist', lwp ) 
     105902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist', lwp ) 
    109106      IF(lwm) WRITE ( numont, namtrc_dta ) 
    110107 
    … …  
    121118                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ') 
    122119               ENDIF 
    123                WRITE(numout,*) ' ' 
    124                WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', & 
     120               WRITE(numout,*) 
     121               WRITE(numout,'(a, i4,3a,e11.3)') '   Read IC file for tracer number :', & 
    125122               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 
    126123            ENDIF 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcice.F90

    r9124 r9169  
    1010   !!   'key_top'                                                TOP models 
    1111   !!---------------------------------------------------------------------- 
    12    !!   trc_ice   :  Call the appropriate sea ice tracer subroutine 
     12   !!   trc_ice       :  Call the appropriate sea ice tracer subroutine 
    1313   !!---------------------------------------------------------------------- 
    14    USE oce_trc         ! shared variables between ocean and passive tracers 
    15    USE trc             ! passive tracers common variables 
    16    USE trcice_cfc      ! CFC      initialisation 
    17    USE trcice_pisces   ! PISCES   initialisation 
    18    USE trcice_c14      ! C14 bomb initialisation 
    19    USE trcice_age      ! aGE initialisation 
    20    USE trcice_my_trc   ! MY_TRC   initialisation 
     14   USE oce_trc        ! shared variables between ocean and passive tracers 
     15   USE trc            ! passive tracers common variables 
     16   USE trcice_cfc     ! CFC      initialisation 
     17   USE trcice_pisces  ! PISCES   initialisation 
     18   USE trcice_c14     ! C14 bomb initialisation 
     19   USE trcice_age     ! AGE      initialisation 
     20   USE trcice_my_trc  ! MY_TRC   initialisation 
    2121    
    2222   IMPLICIT NONE 
    … …  
    3939      !! 
    4040      !! ** Method  : -  
    41       !!             
    4241      !!--------------------------------------------------------------------- 
    4342      ! 
    … …  
    7170      !! 
    7271      !! ** Method  : - 
    73       !! 
    7472      !!--------------------------------------------------------------------- 
    7573      INTEGER :: jn      ! dummy loop indices 
    7674      INTEGER :: ios, ierr     ! Local integer output status for namelist read 
    7775      ! 
    78       TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) :: sn_tri_tracer 
     76      TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) ::   sn_tri_tracer 
    7977      !! 
    8078      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 
    … …  
    8987      REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data 
    9088      READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901) 
    91  901  IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp ) 
    92  
     89 901  IF( ios /= 0 )   CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp ) 
    9390      REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients 
    9491      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 ) 
    95  902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp ) 
     92 902  IF( ios >  0 )  CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp ) 
    9693 
    9794      IF( lwp ) THEN 
    9895         WRITE(numout,*) ' ' 
    99          WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr 
    100          WRITE(numout,*) ' ' 
     96         WRITE(numout,*) '   Namelist : namtrc_ice' 
     97         WRITE(numout,*) '      Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr 
    10198      ENDIF 
    10299      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r9124 r9169  
    5656      IF(lwp) WRITE(numout,*) 
    5757      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers' 
    58       IF(lwp) WRITE(numout,*) '~~~~~~~' 
     58      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    5959      ! 
    6060      CALL trc_ini_ctl   ! control  
    … …  
    109109      CHARACTER (len=25) :: charout 
    110110      !!---------------------------------------------------------------------- 
    111       !                                                              ! masked grid volume 
     111      ! 
     112      IF(lwp) WRITE(numout,*) 
     113      IF(lwp) WRITE(numout,*) 'trc_ini_inv : initial passive tracers inventories' 
     114      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     115      ! 
     116      !                          ! masked grid volume 
    112117      DO jk = 1, jpk 
    113118         cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
    114119      END DO 
    115       !                                                              ! total volume of the ocean  
     120      !                          ! total volume of the ocean  
    116121      areatot = glob_sum( cvol(:,:,:) ) 
    117122      ! 
    118       trai(:) = 0._wp                                                   ! initial content of all tracers 
     123      trai(:) = 0._wp            ! initial content of all tracers 
    119124      DO jn = 1, jptra 
    120125         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
    … …  
    123128      IF(lwp) THEN               ! control print 
    124129         WRITE(numout,*) 
    125          WRITE(numout,*) '  *** Total number of passive tracer jptra = ', jptra 
    126          WRITE(numout,*) '  *** Total volume of ocean                = ', areatot 
    127          WRITE(numout,*) '  *** Total inital content of all tracers ' 
     130         WRITE(numout,*) '   ==>>>  Total number of passive tracer jptra = ', jptra 
     131         WRITE(numout,*) '          Total volume of ocean                = ', areatot 
     132         WRITE(numout,*) '          Total inital content of all tracers ' 
    128133         WRITE(numout,*) 
    129134         DO jn = 1, jptra 
    … …  
    139144         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    140145      ENDIF 
    141 9000  FORMAT('  tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
     1469000  FORMAT('      tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
    142147      ! 
    143148   END SUBROUTINE trc_ini_inv 
    … …  
    177182      IF(lwp) THEN                   ! control print 
    178183         WRITE(numout,*) 
    179          WRITE(numout,*) ' trc_init: Summary for selected passive tracers' 
    180          WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    181          WRITE(numout,*) ' ID     NAME     INI  SBC  CBC  OBC' 
     184         WRITE(numout,*) 'trc_init_sms : Summary for selected passive tracers' 
     185         WRITE(numout,*) '~~~~~~~~~~~~' 
     186         WRITE(numout,*) '    ID     NAME     INI  SBC  CBC  OBC' 
    182187         DO jn = 1, jptra 
    183188            WRITE(numout,9001) jn, TRIM(ctrcnm(jn)), ln_trc_ini(jn), ln_trc_sbc(jn),ln_trc_cbc(jn),ln_trc_obc(jn) 
    184189         END DO 
    185190      ENDIF 
    186 9001  FORMAT(1x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2) 
     1919001  FORMAT(3x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2) 
    187192      ! 
    188193   END SUBROUTINE trc_ini_sms 
     194 
    189195 
    190196   SUBROUTINE trc_ini_trp 
    … …  
    223229      !!---------------------------------------------------------------------- 
    224230      ! 
    225  
    226231      IF( ln_trcdta )   CALL trc_dta_ini( jptra )      ! set initial tracers values 
    227  
     232      ! 
    228233      IF( ln_my_trc )   CALL trc_bc_ini ( jptra )      ! set tracers Boundary Conditions 
    229  
    230  
     234      ! 
     235      ! 
    231236      IF( ln_rsttr ) THEN              ! restart from a file 
    232237        ! 
    … …  
    244249                  ! deallocate data structure if data are not used for damping 
    245250                  IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN 
    246                      IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 
     251                     IF(lwp) WRITE(numout,*) 'trc_ini_state: deallocate data arrays as they are only used to initialize the run' 
    247252                                                  DEALLOCATE( sf_trcdta(jl)%fnow ) 
    248253                     IF( sf_trcdta(jl)%ln_tint )  DEALLOCATE( sf_trcdta(jl)%fdta ) 
    … …  
    257262        !  
    258263      ENDIF 
    259   
     264      ! 
    260265      tra(:,:,:,:) = 0._wp 
    261266      !                                                         ! Partial top/bottom cell: GRADh(trn) 
    … …  
    275280#endif 
    276281      ! 
    277       INTEGER :: ierr 
     282      INTEGER ::   ierr   ! local integer 
    278283      !!---------------------------------------------------------------------- 
    279284      ! 

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r7646 r9169  
    1818   !!   trc_nam    :  Read and print options for the passive tracer run (namelist) 
    1919   !!---------------------------------------------------------------------- 
    20    USE oce_trc           ! shared variables between ocean and passive tracers 
    21    USE trc               ! passive tracers common variables 
    22    USE trd_oce        
    23    USE trdtrc_oce 
    24    USE iom               ! I/O manager 
     20   USE oce_trc     ! shared variables between ocean and passive tracers 
     21   USE trc         ! passive tracers common variables 
     22   USE trd_oce     !        
     23   USE trdtrc_oce  ! 
     24   USE iom         ! I/O manager 
    2525 
    2626   IMPLICIT NONE 
    2727   PRIVATE  
    2828 
    29    PUBLIC trc_nam_run  ! called in trcini 
    30    PUBLIC trc_nam      ! called in trcini 
    31  
    32    TYPE(PTRACER), DIMENSION(jpmaxtrc), PUBLIC  :: sn_tracer  ! type of tracer for saving if not key_iomput 
     29   PUBLIC   trc_nam_run  ! called in trcini 
     30   PUBLIC   trc_nam      ! called in trcini 
     31 
     32   TYPE(PTRACER), DIMENSION(jpmaxtrc), PUBLIC  :: sn_tracer  !: type of tracer for saving if not key_iomput 
    3333 
    3434   !!---------------------------------------------------------------------- 
    … …  
    4949      !!                ( (PISCES, CFC, MY_TRC ) 
    5050      !!--------------------------------------------------------------------- 
    51       INTEGER  ::   jn                  ! dummy loop indice 
     51      INTEGER  ::   jn   ! dummy loop indice 
     52      !!--------------------------------------------------------------------- 
    5253      ! 
    5354      IF( .NOT.l_offline )   CALL trc_nam_run     ! Parameters of the run                                   
    5455      !                
    55       CALL trc_nam_trc     ! passive tracer informations 
     56      CALL trc_nam_trc                            ! passive tracer informations 
    5657      !                                         
    57       IF( ln_rsttr                     )   ln_trcdta     = .FALSE.   ! restart : no need of clim data 
    58       ! 
    59       IF( ln_trcdmp .OR. ln_trcdmp_clo )   ln_trcdta     = .TRUE.   ! damping : need to have clim data 
    60       ! 
    61  
     58      IF( ln_rsttr                     )   ln_trcdta = .FALSE.   ! restart : no need of clim data 
     59      ! 
     60      IF( ln_trcdmp .OR. ln_trcdmp_clo )   ln_trcdta = .TRUE.    ! damping : need to have clim data 
     61      ! 
     62      ! 
    6263      IF(lwp) THEN                   ! control print 
    6364         IF( ln_rsttr ) THEN 
    6465            WRITE(numout,*) 
    65             WRITE(numout,*) '  Read a restart file for passive tracer : ', TRIM( cn_trcrst_in ) 
    66             WRITE(numout,*) 
     66            WRITE(numout,*) '   ==>>>   Read a restart file for passive tracer : ', TRIM( cn_trcrst_in ) 
    6767         ENDIF 
    6868         IF( ln_trcdta .AND. .NOT.ln_rsttr ) THEN 
    6969            WRITE(numout,*) 
    70             WRITE(numout,*) '  Some of the passive tracers are initialised from climatologies ' 
    71             WRITE(numout,*) 
     70            WRITE(numout,*) '   ==>>>   Some of the passive tracers are initialised from climatologies ' 
    7271         ENDIF 
    7372         IF( .NOT.ln_trcdta ) THEN 
    7473            WRITE(numout,*) 
    75             WRITE(numout,*) '  All the passive tracers are initialised with constant values ' 
    76             WRITE(numout,*) 
     74            WRITE(numout,*) '   ==>>>   All the passive tracers are initialised with constant values ' 
    7775         ENDIF 
    7876      ENDIF 
    … …  
    8280      IF(lwp) THEN                              ! control print 
    8381        WRITE(numout,*)  
    84         WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc 
    85         WRITE(numout,*)  
     82        WRITE(numout,*) '   ==>>>   Passive Tracer  time step    rdttrc = nn_dttrc*rdt = ', rdttrc 
    8683      ENDIF 
    8784      ! 
    … …  
    9895      !! 
    9996      !!--------------------------------------------------------------------- 
     97      INTEGER  ::   ios   ! Local integer 
     98      !! 
    10099      NAMELIST/namtrc_run/ nn_dttrc, ln_rsttr, nn_rsttr, ln_top_euler, & 
    101100        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 
    102       ! 
    103       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    104       !!--------------------------------------------------------------------- 
    105       ! 
     101      !!--------------------------------------------------------------------- 
     102      ! 
     103      IF(lwp) WRITE(numout,*) 
    106104      IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists' 
    107       IF(lwp) WRITE(numout,*) '~~~~~~~' 
    108  
     105      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     106      ! 
    109107      CALL ctl_opn( numnat_ref, 'namelist_top_ref'   , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    110108      CALL ctl_opn( numnat_cfg, 'namelist_top_cfg'   , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    111109      IF(lwm) CALL ctl_opn( numont, 'output.namelist.top', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., 1 ) 
    112  
     110      ! 
    113111      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables 
    114112      READ  ( numnat_ref, namtrc_run, IOSTAT = ios, ERR = 901) 
    115 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp ) 
    116  
     113901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp ) 
    117114      REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables 
    118115      READ  ( numnat_cfg, namtrc_run, IOSTAT = ios, ERR = 902 ) 
    119 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp ) 
    120       IF(lwm) WRITE ( numont, namtrc_run ) 
    121  
    122       !  computes the first time step of tracer model 
    123       nittrc000 = nit000 + nn_dttrc - 1 
     116902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp ) 
     117      IF(lwm) WRITE( numont, namtrc_run ) 
     118 
     119      nittrc000 = nit000 + nn_dttrc - 1      ! first time step of tracer model 
    124120 
    125121      IF(lwp) THEN                   ! control print 
    126          WRITE(numout,*) 
    127          WRITE(numout,*) ' Namelist : namtrc_run' 
    128          WRITE(numout,*) '   time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc 
    129          WRITE(numout,*) '   restart  for passive tracer                  ln_rsttr      = ', ln_rsttr 
    130          WRITE(numout,*) '   control of time step for passive tracer      nn_rsttr      = ', nn_rsttr 
    131          WRITE(numout,*) '   first time step for pass. trac.              nittrc000     = ', nittrc000 
    132          WRITE(numout,*) '   Use euler integration for TRC (y/n)          ln_top_euler  = ', ln_top_euler 
    133          WRITE(numout,*) ' ' 
     122         WRITE(numout,*) '   Namelist : namtrc_run' 
     123         WRITE(numout,*) '      time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc 
     124         WRITE(numout,*) '      restart  for passive tracer                  ln_rsttr      = ', ln_rsttr 
     125         WRITE(numout,*) '      control of time step for passive tracer      nn_rsttr      = ', nn_rsttr 
     126         WRITE(numout,*) '      first time step for pass. trac.              nittrc000     = ', nittrc000 
     127         WRITE(numout,*) '      Use euler integration for TRC (y/n)          ln_top_euler  = ', ln_top_euler 
    134128      ENDIF 
    135129      ! 
    136130    END SUBROUTINE trc_nam_run 
    137131 
     132 
    138133   SUBROUTINE trc_nam_trc 
    139134      !!--------------------------------------------------------------------- 
    … …  
    143138      !! 
    144139      !!--------------------------------------------------------------------- 
    145       INTEGER  ::   ios, ierr, icfc       ! Local integer output status for namelist read 
     140      INTEGER ::   ios, ierr, icfc       ! Local integer 
    146141      !! 
    147142      NAMELIST/namtrc/jp_bgc, ln_pisces, ln_my_trc, ln_age, ln_cfc11, ln_cfc12, ln_sf6, ln_c14, & 
    … …  
    154149      IF(lwp) WRITE(numout,*) 
    155150      IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists' 
    156       IF(lwp) WRITE(numout,*) '~~~~~~~' 
     151      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    157152 
    158153      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables 
    159154      READ  ( numnat_ref, namtrc, IOSTAT = ios, ERR = 901) 
    160 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp ) 
    161  
     155901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp ) 
    162156      REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables 
    163157      READ  ( numnat_cfg, namtrc, IOSTAT = ios, ERR = 902 ) 
    164 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp ) 
    165       IF(lwm) WRITE ( numont, namtrc ) 
     158902   IF( ios >  0 )  CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp ) 
     159      IF(lwm) WRITE( numont, namtrc ) 
    166160 
    167161      ! Control settings 
    … …  
    209203      ! 
    210204      IF(lwp) THEN                   ! control print 
    211          WRITE(numout,*) 
    212          WRITE(numout,*) ' Namelist : namtrc' 
    213          WRITE(numout,*) '   Total number of passive tracers              jptra         = ', jptra 
    214          WRITE(numout,*) '   Total number of BGC tracers                  jp_bgc        = ', jp_bgc 
    215          WRITE(numout,*) '   Simulating PISCES model                      ln_pisces     = ', ln_pisces 
    216          WRITE(numout,*) '   Simulating MY_TRC  model                     ln_my_trc     = ', ln_my_trc 
    217          WRITE(numout,*) '   Simulating water mass age                    ln_age        = ', ln_age 
    218          WRITE(numout,*) '   Simulating CFC11 passive tracer              ln_cfc11      = ', ln_cfc11 
    219          WRITE(numout,*) '   Simulating CFC12 passive tracer              ln_cfc12      = ', ln_cfc12 
    220          WRITE(numout,*) '   Simulating SF6 passive tracer                ln_sf6        = ', ln_sf6 
    221          WRITE(numout,*) '   Total number of CFCs tracers                 jp_cfc        = ', jp_cfc 
    222          WRITE(numout,*) '   Simulating C14   passive tracer              ln_c14        = ', ln_c14 
    223          WRITE(numout,*) '   Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta 
    224          WRITE(numout,*) '   Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp 
    225          WRITE(numout,*) '   Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo 
    226          WRITE(numout,*) ' ' 
    227          WRITE(numout,*) ' ' 
     205         WRITE(numout,*) '   Namelist : namtrc' 
     206         WRITE(numout,*) '      Total number of passive tracers              jptra         = ', jptra 
     207         WRITE(numout,*) '      Total number of BGC tracers                  jp_bgc        = ', jp_bgc 
     208         WRITE(numout,*) '      Simulating PISCES model                      ln_pisces     = ', ln_pisces 
     209         WRITE(numout,*) '      Simulating MY_TRC  model                     ln_my_trc     = ', ln_my_trc 
     210         WRITE(numout,*) '      Simulating water mass age                    ln_age        = ', ln_age 
     211         WRITE(numout,*) '      Simulating CFC11 passive tracer              ln_cfc11      = ', ln_cfc11 
     212         WRITE(numout,*) '      Simulating CFC12 passive tracer              ln_cfc12      = ', ln_cfc12 
     213         WRITE(numout,*) '      Simulating SF6 passive tracer                ln_sf6        = ', ln_sf6 
     214         WRITE(numout,*) '      Total number of CFCs tracers                 jp_cfc        = ', jp_cfc 
     215         WRITE(numout,*) '      Simulating C14   passive tracer              ln_c14        = ', ln_c14 
     216         WRITE(numout,*) '      Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta 
     217         WRITE(numout,*) '      Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp 
     218         WRITE(numout,*) '      Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo 
    228219      ENDIF 
    229220      ! 
    … …  
    235226        ! 
    236227      ENDIF 
    237  
     228      ! 
    238229   END SUBROUTINE trc_nam_trc 
     230 
    239231 
    240232   SUBROUTINE trc_nam_trd 
    … …  
    248240      !!                ( (PISCES, CFC, MY_TRC ) 
    249241      !!--------------------------------------------------------------------- 
    250  
    251242#if defined key_trdmxl_trc  || defined key_trdtrc 
    252       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    253       INTEGER ::  ierr 
     243      INTEGER  ::   ios, ierr                 ! Local integer 
    254244      !! 
    255245      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
    … …  
    257247         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
    258248      !!--------------------------------------------------------------------- 
    259  
     249      ! 
    260250      IF(lwp) WRITE(numout,*) 
    261251      IF(lwp) WRITE(numout,*) 'trc_nam_trd : read the passive tracer diagnostics options' 
    262       IF(lwp) WRITE(numout,*) '~~~~~~~' 
    263  
     252      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    264253      ! 
    265254      ALLOCATE( ln_trdtrc(jptra) )  
    … …  
    267256      REWIND( numnat_ref )              ! Namelist namtrc_trd in reference namelist : Passive tracer trends 
    268257      READ  ( numnat_ref, namtrc_trd, IOSTAT = ios, ERR = 905) 
    269 905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in reference namelist', lwp ) 
    270  
     258905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_trd in reference namelist', lwp ) 
    271259      REWIND( numnat_cfg )              ! Namelist namtrc_trd in configuration namelist : Passive tracer trends 
    272260      READ  ( numnat_cfg, namtrc_trd, IOSTAT = ios, ERR = 906 ) 
    273 906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist', lwp ) 
    274       IF(lwm) WRITE ( numont, namtrc_trd ) 
     261906   IF( ios >  0 )  CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist', lwp ) 
     262      IF(lwm) WRITE( numont, namtrc_trd ) 
    275263 
    276264      IF(lwp) THEN 
    277          WRITE(numout,*) 
    278          WRITE(numout,*) ' trd_mxl_trc_init : read namelist namtrc_trd                    ' 
    279          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               ' 
    280          WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc 
    281          WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc 
    282          WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmxl_trc_restart  = ', ln_trdmxl_trc_restart 
    283          WRITE(numout,*) '   * flag to diagnose trends of                                 ' 
    284          WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmxl_trc_instant  = ', ln_trdmxl_trc_instant 
    285          WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc 
     265         WRITE(numout,*) '   Namelist : namtrc_trd                    ' 
     266         WRITE(numout,*) '      frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc 
     267         WRITE(numout,*) '      control surface type              nn_ctls_trc            = ', nn_ctls_trc 
     268         WRITE(numout,*) '      restart for ML diagnostics        ln_trdmxl_trc_restart  = ', ln_trdmxl_trc_restart 
     269         WRITE(numout,*) '      instantantaneous or mean trends   ln_trdmxl_trc_instant  = ', ln_trdmxl_trc_instant 
     270         WRITE(numout,*) '      unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc 
    286271         DO jn = 1, jptra 
    287             IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn 
     272            IF( ln_trdtrc(jn) ) WRITE(numout,*) '      compute ML trends for tracer number :', jn 
    288273         END DO 
    289274      ENDIF 
    … …  
    303288#endif 
    304289 
    305    !!---------------------------------------------------------------------- 
    306    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    307    !! $Id$ 
    308    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    309290   !!====================================================================== 
    310291END MODULE trcnam 
Note: See TracChangeset for help on using the changeset viewer.