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 14072 for NEMO/trunk/src/OCE – NEMO

Changeset 14072 for NEMO/trunk/src/OCE


Ignore:
Timestamp:
2020-12-04T08:48:38+01:00 (3 years ago)
Author:
laurent
Message:

Merging branch "2020/dev_r13648_ASINTER-04_laurent_bulk_ice", ticket #2369

Location:
NEMO/trunk/src/OCE
Files:
1 deleted
87 edited
11 copied

Legend:

Unmodified
Added
Removed

  • NEMO/trunk/src/OCE/ASM/asminc.F90

    r13982 r14072  
    99   !!                 ! 2007-04  (A. Weaver)  Merge with OPAVAR/NEMOVAR 
    1010   !!   NEMO     3.3  ! 2010-05  (D. Lea)  Update to work with NEMO v3.2 
    11    !!             -   ! 2010-05  (D. Lea)  add calc_month_len routine based on day_init  
     11   !!             -   ! 2010-05  (D. Lea)  add calc_month_len routine based on day_init 
    1212   !!            3.4  ! 2012-10  (A. Weaver and K. Mogensen) Fix for direct initialization 
    1313   !!                 ! 2014-09  (D. Lea)  Local calc_date removed use routine from OBS 
    … …  
    3232   USE zpshde          ! Partial step : Horizontal Derivative 
    3333   USE asmpar          ! Parameters for the assmilation interface 
    34    USE asmbkg          !  
     34   USE asmbkg          ! 
    3535   USE c1d             ! 1D initialization 
    3636   USE sbc_oce         ! Surface boundary condition variables. 
    … …  
    4646   IMPLICIT NONE 
    4747   PRIVATE 
    48     
     48 
    4949   PUBLIC   asm_inc_init   !: Initialize the increment arrays and IAU weights 
    5050   PUBLIC   tra_asm_inc    !: Apply the tracer (T and S) increments 
    … …  
    7373   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   u_bkg   , v_bkg      !: Background u- & v- velocity components 
    7474   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   t_bkginc, s_bkginc   !: Increment to the background T & S 
    75    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   u_bkginc, v_bkginc   !: Increment to the u- & v-components  
     75   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   u_bkginc, v_bkginc   !: Increment to the u- & v-components 
    7676   REAL(wp), PUBLIC, DIMENSION(:)    , ALLOCATABLE ::   wgtiau               !: IAU weights for each time step 
    7777#if defined key_asminc 
    … …  
    8181   INTEGER , PUBLIC ::   nitbkg      !: Time step of the background state used in the Jb term 
    8282   INTEGER , PUBLIC ::   nitdin      !: Time step of the background state for direct initialization 
    83    INTEGER , PUBLIC ::   nitiaustr   !: Time step of the start of the IAU interval  
     83   INTEGER , PUBLIC ::   nitiaustr   !: Time step of the start of the IAU interval 
    8484   INTEGER , PUBLIC ::   nitiaufin   !: Time step of the end of the IAU interval 
    85    !  
     85   ! 
    8686   INTEGER , PUBLIC ::   niaufn      !: Type of IAU weighing function: = 0   Constant weighting 
    87    !                                 !: = 1   Linear hat-like, centred in middle of IAU interval  
     87   !                                 !: = 1   Linear hat-like, centred in middle of IAU interval 
    8888   REAL(wp), PUBLIC ::   salfixmin   !: Ensure that the salinity is larger than this  value if (ln_salfix) 
    8989 
    … …  
    107107      !!---------------------------------------------------------------------- 
    108108      !!                    ***  ROUTINE asm_inc_init  *** 
    109       !!           
     109      !! 
    110110      !! ** Purpose : Initialize the assimilation increment and IAU weights. 
    111111      !! 
    112112      !! ** Method  : Initialize the assimilation increment and IAU weights. 
    113113      !! 
    114       !! ** Action  :  
     114      !! ** Action  : 
    115115      !!---------------------------------------------------------------------- 
    116116      INTEGER, INTENT(in) ::  Kbb, Kmm, Krhs  ! time level indices 
    … …  
    264264         ! 
    265265         !                                !--------------------------------------------------------- 
    266          IF( niaufn == 0 ) THEN           ! Constant IAU forcing  
     266         IF( niaufn == 0 ) THEN           ! Constant IAU forcing 
    267267            !                             !--------------------------------------------------------- 
    268268            DO jt = 1, iiauper 
    … …  
    270270            END DO 
    271271            !                             !--------------------------------------------------------- 
    272          ELSEIF ( niaufn == 1 ) THEN      ! Linear hat-like, centred in middle of IAU interval  
     272         ELSEIF ( niaufn == 1 ) THEN      ! Linear hat-like, centred in middle of IAU interval 
    273273            !                             !--------------------------------------------------------- 
    274274            ! Compute the normalization factor 
    275275            znorm = 0._wp 
    276276            IF( MOD( iiauper, 2 ) == 0 ) THEN   ! Even number of time steps in IAU interval 
    277                imid = iiauper / 2  
     277               imid = iiauper / 2 
    278278               DO jt = 1, imid 
    279279                  znorm = znorm + REAL( jt ) 
    … …  
    281281               znorm = 2.0 * znorm 
    282282            ELSE                                ! Odd number of time steps in IAU interval 
    283                imid = ( iiauper + 1 ) / 2         
     283               imid = ( iiauper + 1 ) / 2 
    284284               DO jt = 1, imid - 1 
    285285                  znorm = znorm + REAL( jt ) 
    … …  
    308308             DO jt = 1, icycper 
    309309                ztotwgt = ztotwgt + wgtiau(jt) 
    310                 WRITE(numout,*) '         ', jt, '       ', wgtiau(jt)  
    311              END DO    
     310                WRITE(numout,*) '         ', jt, '       ', wgtiau(jt) 
     311             END DO 
    312312             WRITE(numout,*) '         ===================================' 
    313313             WRITE(numout,*) '         Time-integrated weight = ', ztotwgt 
    314314             WRITE(numout,*) '         ===================================' 
    315315          ENDIF 
    316           
     316 
    317317      ENDIF 
    318318 
    … …  
    339339         CALL iom_open( c_asminc, inum ) 
    340340         ! 
    341          CALL iom_get( inum, 'time'       , zdate_inc   )  
     341         CALL iom_get( inum, 'time'       , zdate_inc   ) 
    342342         CALL iom_get( inum, 'z_inc_dateb', z_inc_dateb ) 
    343343         CALL iom_get( inum, 'z_inc_datef', z_inc_datef ) 
    … …  
    346346         ! 
    347347         IF(lwp) THEN 
    348             WRITE(numout,*)  
     348            WRITE(numout,*) 
    349349            WRITE(numout,*) 'asm_inc_init : Assimilation increments valid between dates ', z_inc_dateb,' and ', z_inc_datef 
    350350            WRITE(numout,*) '~~~~~~~~~~~~' 
    … …  
    360360            &                ' not agree with Direct Initialization time' ) 
    361361 
    362          IF ( ln_trainc ) THEN    
     362         IF ( ln_trainc ) THEN 
    363363            CALL iom_get( inum, jpdom_auto, 'bckint', t_bkginc, 1 ) 
    364364            CALL iom_get( inum, jpdom_auto, 'bckins', s_bkginc, 1 ) 
    … …  
    372372         ENDIF 
    373373 
    374          IF ( ln_dyninc ) THEN    
    375             CALL iom_get( inum, jpdom_auto, 'bckinu', u_bkginc, 1 )               
    376             CALL iom_get( inum, jpdom_auto, 'bckinv', v_bkginc, 1 )               
     374         IF ( ln_dyninc ) THEN 
     375            CALL iom_get( inum, jpdom_auto, 'bckinu', u_bkginc, 1 ) 
     376            CALL iom_get( inum, jpdom_auto, 'bckinv', v_bkginc, 1 ) 
    377377            ! Apply the masks 
    378378            u_bkginc(:,:,:) = u_bkginc(:,:,:) * umask(:,:,:) 
    … …  
    383383            WHERE( ABS( v_bkginc(:,:,:) ) > 1.0e+10 ) v_bkginc(:,:,:) = 0.0 
    384384         ENDIF 
    385          
     385 
    386386         IF ( ln_sshinc ) THEN 
    387387            CALL iom_get( inum, jpdom_auto, 'bckineta', ssh_bkginc, 1 ) 
    … …  
    409409      IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN    ! Apply divergence damping filter 
    410410         !                                         !-------------------------------------- 
    411          ALLOCATE( zhdiv(jpi,jpj) )  
     411         ALLOCATE( zhdiv(jpi,jpj) ) 
    412412         ! 
    413413         DO jt = 1, nn_divdmp 
    … …  
    428428                     &               + 0.2_wp * ( zhdiv(ji+1,jj) - zhdiv(ji  ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
    429429                  v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk)                         & 
    430                      &               + 0.2_wp * ( zhdiv(ji,jj+1) - zhdiv(ji,jj  ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)  
     430                     &               + 0.2_wp * ( zhdiv(ji,jj+1) - zhdiv(ji,jj  ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
    431431               END_2D 
    432432            END DO 
    … …  
    434434         END DO 
    435435         ! 
    436          DEALLOCATE( zhdiv )  
     436         DEALLOCATE( zhdiv ) 
    437437         ! 
    438438      ENDIF 
    … …  
    455455         CALL iom_open( c_asmdin, inum ) 
    456456         ! 
    457          CALL iom_get( inum, 'rdastp', zdate_bkg )  
     457         CALL iom_get( inum, 'rdastp', zdate_bkg ) 
    458458         ! 
    459459         IF(lwp) THEN 
    460             WRITE(numout,*)  
     460            WRITE(numout,*) 
    461461            WRITE(numout,*) '   ==>>>  Assimilation background state valid at : ', zdate_bkg 
    462462            WRITE(numout,*) 
    … …  
    467467            &                ' not agree with Direct Initialization time' ) 
    468468         ! 
    469          IF ( ln_trainc ) THEN    
     469         IF ( ln_trainc ) THEN 
    470470            CALL iom_get( inum, jpdom_auto, 'tn', t_bkg ) 
    471471            CALL iom_get( inum, jpdom_auto, 'sn', s_bkg ) 
    … …  
    474474         ENDIF 
    475475         ! 
    476          IF ( ln_dyninc ) THEN    
     476         IF ( ln_dyninc ) THEN 
    477477            CALL iom_get( inum, jpdom_auto, 'un', u_bkg, cd_type = 'U', psgn = 1._wp ) 
    478478            CALL iom_get( inum, jpdom_auto, 'vn', v_bkg, cd_type = 'V', psgn = 1._wp ) 
    … …  
    502502      ! 
    503503   END SUBROUTINE asm_inc_init 
    504     
    505     
     504 
     505 
    506506   SUBROUTINE tra_asm_inc( kt, Kbb, Kmm, pts, Krhs ) 
    507507      !!---------------------------------------------------------------------- 
    508508      !!                    ***  ROUTINE tra_asm_inc  *** 
    509       !!           
     509      !! 
    510510      !! ** Purpose : Apply the tracer (T and S) assimilation increments 
    511511      !! 
    512512      !! ** Method  : Direct initialization or Incremental Analysis Updating 
    513513      !! 
    514       !! ** Action  :  
     514      !! ** Action  : 
    515515      !!---------------------------------------------------------------------- 
    516516      INTEGER                                  , INTENT(in   ) :: kt             ! Current time step 
    … …  
    524524      !!---------------------------------------------------------------------- 
    525525      ! 
    526       ! freezing point calculation taken from oc_fz_pt (but calculated for all depths)  
    527       ! used to prevent the applied increments taking the temperature below the local freezing point  
     526      ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 
     527      ! used to prevent the applied increments taking the temperature below the local freezing point 
    528528      IF( ln_temnofreeze ) THEN 
    529529         DO jk = 1, jpkm1 
    … …  
    587587      ELSEIF ( ln_asmdin ) THEN        ! Direct Initialization 
    588588         !                             !-------------------------------------- 
    589          !             
     589         ! 
    590590         IF ( kt == nitdin_r ) THEN 
    591591            ! 
    … …  
    647647         ! 
    648648         ENDIF 
    649          !   
     649         ! 
    650650      ENDIF 
    651651      ! Perhaps the following call should be in step 
    … …  
    658658      !!---------------------------------------------------------------------- 
    659659      !!                    ***  ROUTINE dyn_asm_inc  *** 
    660       !!           
     660      !! 
    661661      !! ** Purpose : Apply the dynamics (u and v) assimilation increments. 
    662662      !! 
    663663      !! ** Method  : Direct initialization or Incremental Analysis Updating. 
    664664      !! 
    665       !! ** Action  :  
     665      !! ** Action  : 
    666666      !!---------------------------------------------------------------------- 
    667667      INTEGER                             , INTENT( in )  ::  kt             ! ocean time-step index 
    … …  
    684684            ! 
    685685            IF(lwp) THEN 
    686                WRITE(numout,*)  
     686               WRITE(numout,*) 
    687687               WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    688688               WRITE(numout,*) '~~~~~~~~~~~~' 
    … …  
    704704      ELSEIF ( ln_asmdin ) THEN     ! Direct Initialization 
    705705         !                          !----------------------------------------- 
    706          !          
     706         ! 
    707707         IF ( kt == nitdin_r ) THEN 
    708708            ! 
    … …  
    711711            ! Initialize the now fields with the background + increment 
    712712            puu(:,:,:,Kmm) = u_bkg(:,:,:) + u_bkginc(:,:,:) 
    713             pvv(:,:,:,Kmm) = v_bkg(:,:,:) + v_bkginc(:,:,:)   
     713            pvv(:,:,:,Kmm) = v_bkg(:,:,:) + v_bkginc(:,:,:) 
    714714            ! 
    715715            puu(:,:,:,Kbb) = puu(:,:,:,Kmm)         ! Update before fields 
    … …  
    730730      !!---------------------------------------------------------------------- 
    731731      !!                    ***  ROUTINE ssh_asm_inc  *** 
    732       !!           
     732      !! 
    733733      !! ** Purpose : Apply the sea surface height assimilation increment. 
    734734      !! 
    735735      !! ** Method  : Direct initialization or Incremental Analysis Updating. 
    736736      !! 
    737       !! ** Action  :  
     737      !! ** Action  : 
    738738      !!---------------------------------------------------------------------- 
    739739      INTEGER, INTENT(IN) :: kt         ! Current time step 
    … …  
    755755            ! 
    756756            IF(lwp) THEN 
    757                WRITE(numout,*)  
     757               WRITE(numout,*) 
    758758               WRITE(numout,*) 'ssh_asm_inc : SSH IAU at time step = ', & 
    759759                  &  kt,' with IAU weight = ', wgtiau(it) 
    … …  
    807807      !!                  ***  ROUTINE ssh_asm_div  *** 
    808808      !! 
    809       !! ** Purpose :   ssh increment with z* is incorporated via a correction of the local divergence           
     809      !! ** Purpose :   ssh increment with z* is incorporated via a correction of the local divergence 
    810810      !!                across all the water column 
    811811      !! 
    … …  
    823823      REAL(wp), DIMENSION(:,:)  , POINTER       ::   ztim     ! local array 
    824824      !!---------------------------------------------------------------------- 
    825       !  
     825      ! 
    826826#if defined key_asminc 
    827827      CALL ssh_asm_inc( kt, Kbb, Kmm ) !==   (calculate increments) 
    828828      ! 
    829       IF( ln_linssh ) THEN  
     829      IF( ln_linssh ) THEN 
    830830         phdivn(:,:,1) = phdivn(:,:,1) - ssh_iau(:,:) / e3t(:,:,1,Kmm) * tmask(:,:,1) 
    831       ELSE  
     831      ELSE 
    832832         ALLOCATE( ztim(jpi,jpj) ) 
    833833         ztim(:,:) = ssh_iau(:,:) / ( ht(:,:) + 1.0 - ssmask(:,:) ) 
    834          DO jk = 1, jpkm1                                  
    835             phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk)  
     834         DO jk = 1, jpkm1 
     835            phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk) 
    836836         END DO 
    837837         ! 
    … …  
    846846      !!---------------------------------------------------------------------- 
    847847      !!                    ***  ROUTINE seaice_asm_inc  *** 
    848       !!           
     848      !! 
    849849      !! ** Purpose : Apply the sea ice assimilation increment. 
    850850      !! 
    851851      !! ** Method  : Direct initialization or Incremental Analysis Updating. 
    852852      !! 
    853       !! ** Action  :  
     853      !! ** Action  : 
    854854      !! 
    855855      !!---------------------------------------------------------------------- 
    … …  
    873873            ! 
    874874            it = kt - nit000 + 1 
    875             zincwgt = wgtiau(it)      ! IAU weight for the current time step  
     875            zincwgt = wgtiau(it)      ! IAU weight for the current time step 
    876876            ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments) 
    877877            ! 
    … …  
    997997!#if defined defined key_si3 || defined key_cice 
    998998! 
    999 !            IF (ln_seaicebal ) THEN        
     999!            IF (ln_seaicebal ) THEN 
    10001000!             !! balancing salinity increments 
    10011001!             !! simple case from limflx.F90 (doesn't include a mass flux) 
    … …  
    10091009! 
    10101010!             DO jj = 1, jpj 
    1011 !               DO ji = 1, jpi  
     1011!               DO ji = 1, jpi 
    10121012!           ! calculate change in ice and snow mass per unit area 
    10131013!           ! positive values imply adding salt to the ocean (results from ice formation) 
    … …  
    10201020! 
    10211021!           ! prevent small mld 
    1022 !           ! less than 10m can cause salinity instability  
     1022!           ! less than 10m can cause salinity instability 
    10231023!                 IF (mld < 10) mld=10 
    10241024! 
    1025 !           ! set to bottom of a level  
     1025!           ! set to bottom of a level 
    10261026!                 DO jk = jpk-1, 2, -1 
    10271027!                   IF ((mld > gdepw(ji,jj,jk,Kmm)) .and. (mld < gdepw(ji,jj,jk+1,Kmm))) THEN 
    … …  
    10321032! 
    10331033!            ! avoid applying salinity balancing in shallow water or on land 
    1034 !            !  
     1034!            ! 
    10351035! 
    10361036!            ! dsal_ocn (psu kg m^-2) / (kg m^-3 * m) 
    … …  
    10431043! 
    10441044!           ! put increments in for levels in the mixed layer 
    1045 !           ! but prevent salinity below a threshold value  
    1046 ! 
    1047 !                   DO jk = 1, jkmax               
    1048 ! 
    1049 !                     IF (dsal_ocn > 0.0_wp .or. sb(ji,jj,jk)+dsal_ocn > sal_thresh) THEN  
     1045!           ! but prevent salinity below a threshold value 
     1046! 
     1047!                   DO jk = 1, jkmax 
     1048! 
     1049!                     IF (dsal_ocn > 0.0_wp .or. sb(ji,jj,jk)+dsal_ocn > sal_thresh) THEN 
    10501050!                           sb(ji,jj,jk) = sb(ji,jj,jk) + dsal_ocn 
    10511051!                           sn(ji,jj,jk) = sn(ji,jj,jk) + dsal_ocn 
    … …  
    10581058!      ! 
    10591059!      !! Adjust fsalt. A +ve fsalt means adding salt to ocean 
    1060 !      !!           fsalt(ji,jj) =  fsalt(ji,jj) + zpmess     ! adjust fsalt   
    1061 !      !!                
    1062 !      !!           emps(ji,jj) = emps(ji,jj) + zpmess        ! or adjust emps (see icestp1d)  
     1060!      !!           fsalt(ji,jj) =  fsalt(ji,jj) + zpmess     ! adjust fsalt 
     1061!      !! 
     1062!      !!           emps(ji,jj) = emps(ji,jj) + zpmess        ! or adjust emps (see icestp1d) 
    10631063!      !!                                                     ! E-P (kg m-2 s-2) 
    10641064!      !            emp(ji,jj) = emp(ji,jj) + zpmess          ! E-P (kg m-2 s-2) 
    … …  
    10731073      ! 
    10741074   END SUBROUTINE seaice_asm_inc 
    1075     
     1075 
    10761076   !!====================================================================== 
    10771077END MODULE asminc 

  • NEMO/trunk/src/OCE/BDY/bdytra.F90

    r13982 r14072  
    3030   END TYPE 
    3131 
    32    PUBLIC   bdy_tra      ! called in tranxt.F90  
    33    PUBLIC   bdy_tra_dmp  ! called in step.F90  
     32   PUBLIC   bdy_tra      ! called in tranxt.F90 
     33   PUBLIC   bdy_tra_dmp  ! called in step.F90 
    3434 
    3535   !!---------------------------------------------------------------------- 
    3636   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    37    !! $Id$  
     37   !! $Id$ 
    3838   !! Software governed by the CeCILL license (see ./LICENSE) 
    3939   !!---------------------------------------------------------------------- 
    … …  
    5656      LOGICAL, DIMENSION(4)          :: llsend1, llrecv1       ! indicate how communications are to be carried out 
    5757      !!---------------------------------------------------------------------- 
    58       igrd = 1  
     58      igrd = 1 
    5959      llsend1(:) = .false.  ;   llrecv1(:) = .false. 
    6060      DO ir = 1, 0, -1   ! treat rim 1 before rim 0 
    … …  
    8383               CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
    8484               END SELECT 
    85                !  
     85               ! 
    8686            END DO 
    8787         END DO 
    … …  
    111111      !!---------------------------------------------------------------------- 
    112112      !!                 ***  SUBROUTINE bdy_rnf  *** 
    113       !!                     
     113      !! 
    114114      !! ** Purpose : Specialized routine to apply TRA runoff values at OBs: 
    115115      !!                  - duplicate the neighbour value for the temperature 
    116116      !!                  - specified to 0.1 PSU for the salinity 
    117       !!  
     117      !! 
    118118      !!---------------------------------------------------------------------- 
    119119      TYPE(OBC_INDEX),                     INTENT(in) ::   idx      ! OBC indices 
    … …  
    143143      !!---------------------------------------------------------------------- 
    144144      !!                 ***  SUBROUTINE bdy_tra_dmp  *** 
    145       !!                     
     145      !! 
    146146      !! ** Purpose : Apply damping for tracers at open boundaries. 
    147       !!  
     147      !! 
    148148      !!---------------------------------------------------------------------- 
    149149      INTEGER                                  , INTENT(in)    :: kt        ! time step 
    … …  
    181181      ! 
    182182   END SUBROUTINE bdy_tra_dmp 
    183   
     183 
    184184   !!====================================================================== 
    185185END MODULE bdytra 

  • NEMO/trunk/src/OCE/C1D/step_c1d.F90

    r14010 r14072  
    1111   !!---------------------------------------------------------------------- 
    1212   !!   'key_c1d'                                       1D Configuration 
    13    !!----------------------------------------------------------------------   
     13   !!---------------------------------------------------------------------- 
    1414   !!   stp_c1d        : NEMO system time-stepping in c1d case 
    1515   !!---------------------------------------------------------------------- 
    16    USE step_oce        ! time stepping definition modules  
     16   USE step_oce        ! time stepping definition modules 
    1717   USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices 
    1818#if defined key_top 
    … …  
    2222   USE dynatf          ! time filtering                   (dyn_atf routine) 
    2323   USE dyndmp          ! U & V momentum damping           (dyn_dmp routine) 
    24    USE restart         ! restart  
     24   USE restart         ! restart 
    2525 
    2626   IMPLICIT NONE 
    … …  
    3939      !!---------------------------------------------------------------------- 
    4040      !!                     ***  ROUTINE stp_c1d  *** 
    41       !!                       
     41      !! 
    4242      !! ** Purpose :  - Time stepping of SBC including sea ice (dynamic and thermodynamic eqs.) 
    4343      !!               - Time stepping of OPA (momentum and active tracer eqs.) 
    4444      !!               - Time stepping of TOP (passive tracer eqs.) 
    45       !!  
    46       !! ** Method  : -1- Update forcings and data   
    47       !!              -2- Update vertical ocean physics  
    48       !!              -3- Compute the t and s trends  
    49       !!              -4- Update t and s  
     45      !! 
     46      !! ** Method  : -1- Update forcings and data 
     47      !!              -2- Update vertical ocean physics 
     48      !!              -3- Compute the t and s trends 
     49      !!              -4- Update t and s 
    5050      !!              -5- Compute the momentum trends 
    5151      !!              -6- Update the horizontal velocity 
    … …  
    6767 
    6868      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    69       ! Ocean physics update         
     69      ! Ocean physics update 
    7070      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    7171                         CALL eos_rab( ts(:,:,:,:,Nbb), rab_b, Nnn )  ! before local thermal/haline expension ratio at T-points 
    … …  
    7373                         CALL bn2( ts(:,:,:,:,Nbb), rab_b, rn2b, Nnn ) ! before Brunt-Vaisala frequency 
    7474                         CALL bn2( ts(:,:,:,:,Nnn), rab_n, rn2 , Nnn ) ! now    Brunt-Vaisala frequency 
    75        
     75 
    7676      !  VERTICAL PHYSICS 
    7777                         CALL zdf_phy( kstp, Nbb, Nnn, Nrhs  )    ! vertical physics update (bfr, avt, avs, avm + MLD) 
    7878 
    7979      IF(.NOT.ln_linssh )   CALL ssh_nxt       ( kstp, Nbb, Nnn, ssh, Naa )  ! after ssh (includes call to div_hor) 
    80       IF(.NOT.ln_linssh )   CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn,      Naa )  ! after vertical scale factors  
     80      IF(.NOT.ln_linssh )   CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn,      Naa )  ! after vertical scale factors 
    8181 
    82       IF(.NOT.ln_linssh )   CALL wzv           ( kstp, Nbb, Nnn, Naa, ww )  ! now cross-level velocity  
     82      IF(.NOT.ln_linssh )   CALL wzv           ( kstp, Nbb, Nnn, Naa, ww )  ! now cross-level velocity 
    8383      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    84       ! diagnostics and outputs        
     84      ! diagnostics and outputs 
    8585      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    8686                         CALL dia_wri( kstp, Nnn )  ! ocean model: outputs 
    … …  
    123123                        CALL dyn_atf    ( kstp, Nbb, Nnn, Naa , uu, vv, e3t, e3u, e3v )  ! time filtering of "now" fields 
    124124      IF(.NOT.ln_linssh)CALL ssh_atf    ( kstp, Nbb, Nnn, Naa , ssh )                    ! time filtering of "now" sea surface height 
    125       IF( kstp == nit000 .AND. ln_linssh) THEN  
    126          ssh(:,:,Naa) = ssh(:,:,Nnn)  ! init ssh after in ln_linssh case  
     125      IF( kstp == nit000 .AND. ln_linssh) THEN 
     126         ssh(:,:,Naa) = ssh(:,:,Nnn)  ! init ssh after in ln_linssh case 
    127127      ENDIF 
    128128      ! 

  • NEMO/trunk/src/OCE/DIA/diaar5.F90

    r13982 r14072  
    1010   !!   dia_ar5_init  : initialisation of AR5 diagnostics 
    1111   !!---------------------------------------------------------------------- 
    12    USE oce            ! ocean dynamics and active tracers  
     12   USE oce            ! ocean dynamics and active tracers 
    1313   USE dom_oce        ! ocean space and time domain 
    1414   USE eosbn2         ! equation of state                (eos_bn2 routine) 
    … …  
    3737 
    3838   LOGICAL  :: l_ar5 
    39        
     39 
    4040   !! * Substitutions 
    4141#  include "do_loop_substitute.h90" 
    … …  
    7878      REAL(wp) ::   zaw, zbw, zrw 
    7979      ! 
    80       REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace  
    81       REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z2d, zpe                   ! 2D workspace  
     80      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace 
     81      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z2d, zpe                   ! 2D workspace 
    8282      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: z3d, zrhd, ztpot, zgdept   ! 3D workspace (zgdept: needed to use the substitute) 
    8383      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace 
    … …  
    8585      !!-------------------------------------------------------------------- 
    8686      IF( ln_timing )   CALL timing_start('dia_ar5') 
    87   
     87 
    8888      IF( kt == nit000 )     CALL dia_ar5_init 
    8989 
    90       IF( l_ar5 ) THEN  
     90      IF( l_ar5 ) THEN 
    9191         ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) ) 
    9292         ALLOCATE( zrhd(jpi,jpj,jpk) ) 
    … …  
    9999      CALL iom_put( 'areacello', e1e2t(:,:) ) 
    100100      ! 
    101       IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' )  ) THEN   
     101      IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' )  ) THEN 
    102102         zrhd(:,:,jpk) = 0._wp        ! ocean volume ; rhd is used as workspace 
    103103         DO jk = 1, jpkm1 
    … …  
    106106         DO jk = 1, jpk 
    107107            z3d(:,:,jk) =  rho0 * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    108          END DO  
     108         END DO 
    109109         CALL iom_put( 'volcello'  , zrhd(:,:,:)  )  ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 
    110110         CALL iom_put( 'masscello' , z3d (:,:,:) )   ! ocean mass 
    111       ENDIF  
     111      ENDIF 
    112112      ! 
    113113      IF( iom_use( 'e3tb' ) )  THEN    ! bottom layer thickness 
    … …  
    117117         END_2D 
    118118         CALL iom_put( 'e3tb', z2d ) 
    119       ENDIF  
    120       ! 
    121       IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' )  .OR. iom_use( 'sshdyn' )  ) THEN     
     119      ENDIF 
     120      ! 
     121      IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' )  .OR. iom_use( 'sshdyn' )  ) THEN 
    122122         !                                         ! total volume of liquid seawater 
    123          zvolssh = glob_sum( 'diaar5', zarea_ssh(:,:) )  
     123         zvolssh = glob_sum( 'diaar5', zarea_ssh(:,:) ) 
    124124         zvol    = vol0 + zvolssh 
    125        
     125 
    126126         CALL iom_put( 'voltot', zvol               ) 
    127127         CALL iom_put( 'sshtot', zvolssh / area_tot ) 
    … …  
    130130      ENDIF 
    131131 
    132       IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) THEN     
    133          !                      
     132      IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) THEN 
     133         ! 
    134134         ztsn(:,:,:,jp_tem) = ts(:,:,:,jp_tem,Kmm)                    ! thermosteric ssh 
    135135         ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
    … …  
    157157!!gm 
    158158         END IF 
    159          !                                          
    160          zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) )  
     159         ! 
     160         zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) 
    161161         zssh_steric = - zarho / area_tot 
    162162         CALL iom_put( 'sshthster', zssh_steric ) 
    163        
     163 
    164164         !                                         ! steric sea surface height 
    165165         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    … …  
    179179            END IF 
    180180         END IF 
    181          !     
    182          zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) )  
     181         ! 
     182         zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) 
    183183         zssh_steric = - zarho / area_tot 
    184184         CALL iom_put( 'sshsteric', zssh_steric ) 
    … …  
    192192      ENDIF 
    193193 
    194       IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' )  .OR. iom_use( 'saltot' )  ) THEN     
     194      IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' )  .OR. iom_use( 'saltot' )  ) THEN 
    195195          !                                         ! Mean density anomalie, temperature and salinity 
    196196          ztsn(:,:,:,:) = 0._wp                    ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity 
    … …  
    206206                  DO jj = 1, jpj 
    207207                     iks = mikt(ji,jj) 
    208                      ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_tem,Kmm)  
    209                      ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_sal,Kmm)  
     208                     ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_tem,Kmm) 
     209                     ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_sal,Kmm) 
    210210                  END DO 
    211211               END DO 
    212212            ELSE 
    213                ztsn(:,:,1,jp_tem) = ztsn(:,:,1,jp_tem) + zarea_ssh(:,:) * ts(:,:,1,jp_tem,Kmm)  
    214                ztsn(:,:,1,jp_sal) = ztsn(:,:,1,jp_sal) + zarea_ssh(:,:) * ts(:,:,1,jp_sal,Kmm)  
     213               ztsn(:,:,1,jp_tem) = ztsn(:,:,1,jp_tem) + zarea_ssh(:,:) * ts(:,:,1,jp_tem,Kmm) 
     214               ztsn(:,:,1,jp_sal) = ztsn(:,:,1,jp_sal) + zarea_ssh(:,:) * ts(:,:,1,jp_sal,Kmm) 
    215215            END IF 
    216216         ENDIF 
    … …  
    218218         ztemp = glob_sum( 'diaar5', ztsn(:,:,1,jp_tem) ) 
    219219         zsal  = glob_sum( 'diaar5', ztsn(:,:,1,jp_sal) ) 
    220          zmass = rho0 * ( zarho + zvol )       
     220         zmass = rho0 * ( zarho + zvol ) 
    221221         ! 
    222222         CALL iom_put( 'masstot', zmass ) 
    … …  
    224224         CALL iom_put( 'saltot' , zsal  / zvol ) 
    225225         ! 
    226       ENDIF      
     226      ENDIF 
    227227 
    228228      IF( ln_teos10 ) THEN        ! ! potential temperature (TEOS-10 case) 
    … …  
    244244                 z2d(:,:) = z2d(:,:) + e1e2t(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) 
    245245               END DO 
    246                ztemp = glob_sum( 'diaar5', z2d(:,:)  )  
     246               ztemp = glob_sum( 'diaar5', z2d(:,:)  ) 
    247247               CALL iom_put( 'temptot_pot', ztemp / zvol ) 
    248248             ENDIF 
    249249             ! 
    250250             IF( iom_use( 'ssttot' ) ) THEN   ! Output potential temperature in case we use TEOS-10 
    251                zsst = glob_sum( 'diaar5',  e1e2t(:,:) * ztpot(:,:,1)  )  
     251               zsst = glob_sum( 'diaar5',  e1e2t(:,:) * ztpot(:,:,1)  ) 
    252252               CALL iom_put( 'ssttot', zsst / area_tot ) 
    253253             ENDIF 
    … …  
    258258                  z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) *  ztpot(ji,jj,jk) 
    259259               END_3D 
    260                CALL iom_put( 'tosmint_pot', z2d )  
     260               CALL iom_put( 'tosmint_pot', z2d ) 
    261261            ENDIF 
    262262            DEALLOCATE( ztpot ) 
    263263        ENDIF 
    264       ELSE        
     264      ELSE 
    265265         IF( iom_use('ssttot') ) THEN   ! Output sst in case we use EOS-80 
    266266            zsst  = glob_sum( 'diaar5', e1e2t(:,:) * ts(:,:,1,jp_tem,Kmm) ) 
    … …  
    269269      ENDIF 
    270270 
    271       IF( iom_use( 'tnpeo' )) THEN     
     271      IF( iom_use( 'tnpeo' )) THEN 
    272272        ! Work done against stratification by vertical mixing 
    273273        ! Exclude points where rn2 is negative as convection kicks in here and 
    … …  
    358358         ENDIF 
    359359      ENDIF 
    360      
     360 
    361361   END SUBROUTINE dia_ar5_hst 
    362362 
    … …  
    365365      !!---------------------------------------------------------------------- 
    366366      !!                  ***  ROUTINE dia_ar5_init  *** 
    367       !!                    
     367      !! 
    368368      !! ** Purpose :   initialization for AR5 diagnostic computation 
    369369      !!---------------------------------------------------------------------- 
    … …  
    371371      INTEGER  ::   ik, idep 
    372372      INTEGER  ::   ji, jj, jk  ! dummy loop indices 
    373       REAL(wp) ::   zztmp   
     373      REAL(wp) ::   zztmp 
    374374      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity 
    375       REAL(wp), ALLOCATABLE, DIMENSION(:,:)     ::   zvol0      
     375      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     ::   zvol0 
    376376      ! 
    377377      !!---------------------------------------------------------------------- 
    378378      ! 
    379379      l_ar5 = .FALSE. 
    380       IF(   iom_use( 'voltot'  ) .OR. iom_use( 'sshtot'    )  .OR. iom_use( 'sshdyn' )  .OR.  &  
    381          &  iom_use( 'masstot' ) .OR. iom_use( 'temptot'   )  .OR. iom_use( 'saltot' ) .OR.  &     
     380      IF(   iom_use( 'voltot'  ) .OR. iom_use( 'sshtot'    )  .OR. iom_use( 'sshdyn' )  .OR.  & 
     381         &  iom_use( 'masstot' ) .OR. iom_use( 'temptot'   )  .OR. iom_use( 'saltot' ) .OR.  & 
    382382         &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' ) .OR. & 
    383383         &  iom_use( 'uadv_heattr' ) .OR. iom_use( 'udiff_heattr' ) .OR. & 
    … …  
    386386         &  iom_use( 'vadv_salttr' ) .OR. iom_use( 'vdiff_salttr' ) .OR. & 
    387387         &  iom_use( 'rhop' )  ) L_ar5 = .TRUE. 
    388    
     388 
    389389      IF( l_ar5 ) THEN 
    390390         ! 
    … …  
    400400            idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
    401401            zvol0 (ji,jj) = zvol0 (ji,jj) +  idep * e1e2t(ji,jj) 
    402             thick0(ji,jj) = thick0(ji,jj) +  idep     
     402            thick0(ji,jj) = thick0(ji,jj) +  idep 
    403403         END_3D 
    404404         vol0 = glob_sum( 'diaar5', zvol0 ) 
    … …  
    412412            CALL iom_close( inum ) 
    413413 
    414             sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
     414            sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 
    415415            sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
    416416            IF( ln_zps ) THEN               ! z-coord. partial steps 

  • NEMO/trunk/src/OCE/DIA/diahsb.F90

    r13970 r14072  
    44   !! Ocean diagnostics: Heat, salt and volume budgets 
    55   !!====================================================================== 
    6    !! History :  3.3  ! 2010-09  (M. Leclair)  Original code  
     6   !! History :  3.3  ! 2010-09  (M. Leclair)  Original code 
    77   !!                 ! 2012-10  (C. Rousset)  add iom_put 
    88   !!---------------------------------------------------------------------- 
    … …  
    2121   USE domvvl         ! vertical scale factors 
    2222   USE traqsr         ! penetrative solar radiation 
    23    USE trabbc         ! bottom boundary condition  
     23   USE trabbc         ! bottom boundary condition 
    2424   USE trabbc         ! bottom boundary condition 
    2525   USE restart        ! ocean restart 
    … …  
    4444   REAL(wp) ::   frc_wn_t, frc_wn_s    ! global forcing trends 
    4545   ! 
    46    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf  
     46   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf 
    4747   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf_ini      , ssh_ini          ! 
    4848   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   ssh_hc_loc_ini, ssh_sc_loc_ini   ! 
    … …  
    6262      !!--------------------------------------------------------------------------- 
    6363      !!                  ***  ROUTINE dia_hsb  *** 
    64       !!      
     64      !! 
    6565      !! ** Purpose: Compute the ocean global heat content, salt content and volume conservation 
    66       !!  
     66      !! 
    6767      !! ** Method : - Compute the deviation of heat content, salt content and volume 
    6868      !!             at the current time step from their values at nit000 
    … …  
    7575      INTEGER    ::   ji, jj, jk                  ! dummy loop indice 
    7676      REAL(wp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations 
    77       REAL(wp)   ::   zdiff_hc1   , zdiff_sc1     !  -         -     -        -  
     77      REAL(wp)   ::   zdiff_hc1   , zdiff_sc1     !  -         -     -        - 
    7878      REAL(wp)   ::   zdiff_v1    , zdiff_v2      ! volume variation 
    7979      REAL(wp)   ::   zerr_hc1    , zerr_sc1      ! heat and salt content misfit 
    … …  
    8686      REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwrk         ! 3D workspace 
    8787      !!--------------------------------------------------------------------------- 
    88       IF( ln_timing )   CALL timing_start('dia_hsb')       
     88      IF( ln_timing )   CALL timing_start('dia_hsb') 
    8989      ! 
    9090      ts(:,:,:,1,Kmm) = ts(:,:,:,1,Kmm) * tmask(:,:,:) ; ts(:,:,:,1,Kbb) = ts(:,:,:,1,Kbb) * tmask(:,:,:) ; 
    … …  
    119119            z2d1(:,:) = surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_sal,Kbb) 
    120120         END IF 
    121          z_wn_trd_t = - glob_sum( 'diahsb', z2d0 )  
     121         z_wn_trd_t = - glob_sum( 'diahsb', z2d0 ) 
    122122         z_wn_trd_s = - glob_sum( 'diahsb', z2d1 ) 
    123123      ENDIF 
    … …  
    145145            DO ji = 1, jpi 
    146146               DO jj = 1, jpj 
    147                   z2d0(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) )  
    148                   z2d1(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) )  
     147                  z2d0(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) ) 
     148                  z2d1(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) ) 
    149149               END DO 
    150150            END DO 
    151151         ELSE                          ! no under ice-shelf seas 
    152             z2d0(:,:) = surf(:,:) * ( ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) - ssh_hc_loc_ini(:,:) )  
    153             z2d1(:,:) = surf(:,:) * ( ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) - ssh_sc_loc_ini(:,:) )  
     152            z2d0(:,:) = surf(:,:) * ( ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) - ssh_hc_loc_ini(:,:) ) 
     153            z2d1(:,:) = surf(:,:) * ( ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) - ssh_sc_loc_ini(:,:) ) 
    154154         END IF 
    155          z_ssh_hc = glob_sum_full( 'diahsb', z2d0 )  
    156          z_ssh_sc = glob_sum_full( 'diahsb', z2d1 )  
     155         z_ssh_hc = glob_sum_full( 'diahsb', z2d0 ) 
     156         z_ssh_sc = glob_sum_full( 'diahsb', z2d1 ) 
    157157      ENDIF 
    158158      ! 
    … …  
    181181      zdiff_sc = zdiff_sc - frc_s 
    182182      IF( ln_linssh ) THEN 
    183          zdiff_hc1 = zdiff_hc + z_ssh_hc  
     183         zdiff_hc1 = zdiff_hc + z_ssh_hc 
    184184         zdiff_sc1 = zdiff_sc + z_ssh_sc 
    185185         zerr_hc1  = z_ssh_hc - frc_wn_t 
    … …  
    201201!!gm end 
    202202 
    203       CALL iom_put(   'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)  
    204       CALL iom_put(   'bgfrctem' , frc_t    * rho0 * rcp * 1.e-20 )   ! hc  - surface forcing (1.e20 J)  
    205       CALL iom_put(   'bgfrchfx' , frc_t    * rho0 * rcp /  &         ! hc  - surface forcing (W/m2)  
     203      CALL iom_put(   'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3) 
     204      CALL iom_put(   'bgfrctem' , frc_t    * rho0 * rcp * 1.e-20 )   ! hc  - surface forcing (1.e20 J) 
     205      CALL iom_put(   'bgfrchfx' , frc_t    * rho0 * rcp /  &         ! hc  - surface forcing (W/m2) 
    206206         &                       ( surf_tot * kt * rn_Dt )        ) 
    207       CALL iom_put(   'bgfrcsal' , frc_s    * 1.e-9    )              ! sc  - surface forcing (psu*km3)  
     207      CALL iom_put(   'bgfrcsal' , frc_s    * 1.e-9    )              ! sc  - surface forcing (psu*km3) 
    208208 
    209209      IF( .NOT. ln_linssh ) THEN 
    210          CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature drift     (C)  
     210         CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature drift     (C) 
    211211         CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot )              ! Salinity    drift     (PSU) 
    212          CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rho0 * rcp )   ! Heat content drift    (1.e20 J)  
    213          CALL iom_put( 'bgheatfx' , zdiff_hc * rho0 * rcp /  &         ! Heat flux drift       (W/m2)  
     212         CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rho0 * rcp )   ! Heat content drift    (1.e20 J) 
     213         CALL iom_put( 'bgheatfx' , zdiff_hc * rho0 * rcp /  &         ! Heat flux drift       (W/m2) 
    214214            &                       ( surf_tot * kt * rn_Dt )        ) 
    215215         CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9    )              ! Salt content drift    (psu*km3) 
    216          CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3)   
    217          CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9    )              ! volume e3t drift      (km3)   
     216         CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3) 
     217         CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9    )              ! volume e3t drift      (km3) 
    218218         ! 
    219219         IF( kt == nitend .AND. lwp ) THEN 
    … …  
    228228         ! 
    229229      ELSE 
    230          CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content drift    (C)  
     230         CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content drift    (C) 
    231231         CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content drift    (PSU) 
    232          CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rho0 * rcp )  ! Heat content drift    (1.e20 J)  
    233          CALL iom_put( 'bgheatfx' , zdiff_hc1 * rho0 * rcp /  &        ! Heat flux drift       (W/m2)  
     232         CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rho0 * rcp )  ! Heat content drift    (1.e20 J) 
     233         CALL iom_put( 'bgheatfx' , zdiff_hc1 * rho0 * rcp /  &        ! Heat flux drift       (W/m2) 
    234234            &                       ( surf_tot * kt * rn_Dt )         ) 
    235235         CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9    )             ! Salt content drift    (psu*km3) 
    236          CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3)   
     236         CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3) 
    237237         CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot )              ! hc  - error due to free surface (C) 
    238238         CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot )              ! sc  - error due to free surface (psu) 
    … …  
    249249      !!--------------------------------------------------------------------- 
    250250      !!                   ***  ROUTINE dia_hsb_rst  *** 
    251       !!                      
     251      !! 
    252252      !! ** Purpose :   Read or write DIA file in restart file 
    253253      !! 
    … …  
    261261      !!---------------------------------------------------------------------- 
    262262      ! 
    263       IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
     263      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
    264264         IF( ln_rstart ) THEN                   !* Read the restart file 
    265265            ! 
    … …  
    298298            END DO 
    299299            frc_v = 0._wp                                           ! volume       trend due to forcing 
    300             frc_t = 0._wp                                           ! heat content   -    -   -    -    
    301             frc_s = 0._wp                                           ! salt content   -    -   -    -         
     300            frc_t = 0._wp                                           ! heat content   -    -   -    - 
     301            frc_s = 0._wp                                           ! salt content   -    -   -    - 
    302302            IF( ln_linssh ) THEN 
    303303               IF( ln_isfcav ) THEN 
    … …  
    349349      !!--------------------------------------------------------------------------- 
    350350      !!                  ***  ROUTINE dia_hsb  *** 
    351       !!      
     351      !! 
    352352      !! ** Purpose: Initialization for the heat salt volume budgets 
    353       !!  
     353      !! 
    354354      !! ** Method : Compute initial heat content, salt content and volume 
    355355      !! 
    … …  
    403403      surf_tot  = glob_sum( 'diahsb', surf(:,:) )         ! total ocean surface area 
    404404 
    405       IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' )          
     405      IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' ) 
    406406      ! 
    407407      ! ---------------------------------- ! 

  • NEMO/trunk/src/OCE/DIA/diaptr.F90

    r13982 r14072  
    6666   !!---------------------------------------------------------------------- 
    6767   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    68    !! $Id$  
     68   !! $Id$ 
    6969   !! Software governed by the CeCILL license (see ./LICENSE) 
    7070   !!---------------------------------------------------------------------- 
    … …  
    7575      !!                  ***  ROUTINE dia_ptr  *** 
    7676      !!---------------------------------------------------------------------- 
    77       INTEGER                         , INTENT(in)           ::   kt     ! ocean time-step index      
     77      INTEGER                         , INTENT(in)           ::   kt     ! ocean time-step index 
    7878      INTEGER                         , INTENT(in)           ::   Kmm    ! time level index 
    7979      REAL(wp), DIMENSION(A2D(nn_hls),jpk)    , INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport 
    … …  
    177177 
    178178         IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 
    179             ! Calculate barotropic heat and salt transport here  
     179            ! Calculate barotropic heat and salt transport here 
    180180            ALLOCATE( sjk(jpj,1,nbasin), r1_sjk(jpj,1,nbasin) ) 
    181181            ! 
    … …  
    245245         ! 
    246246         !                                ! Advective and diffusive heat and salt transport 
    247          IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN   
    248             !  
     247         IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN 
     248            ! 
    249249            DO jn = 1, nbasin 
    250250               z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
    … …  
    263263         ENDIF 
    264264         ! 
    265          IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN   
    266             !  
     265         IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN 
     266            ! 
    267267            DO jn = 1, nbasin 
    268268               z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
    … …  
    281281         ENDIF 
    282282         ! 
    283          IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN   
    284             !  
     283         IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN 
     284            ! 
    285285            DO jn = 1, nbasin 
    286286               z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
    … …  
    319319            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
    320320            CALL iom_get_var(  'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml 
    321             z2d(:,:) = ptr_ci_2d( z2d(:,:) )   
     321            z2d(:,:) = ptr_ci_2d( z2d(:,:) ) 
    322322            CALL iom_put( 'uocetr_vsum_cumul', z2d ) 
    323323            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain 
    … …  
    455455      !!---------------------------------------------------------------------- 
    456456      !!                  ***  ROUTINE dia_ptr_init  *** 
    457       !!                    
     457      !! 
    458458      !! ** Purpose :   Initialization 
    459459      !!---------------------------------------------------------------------- 
    … …  
    472472         &       iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR.  & 
    473473         &       iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) 
    474        
     474 
    475475      IF(lwp) THEN                     ! Control print 
    476476         WRITE(numout,*) 
    … …  
    480480      ENDIF 
    481481 
    482       IF( l_diaptr ) THEN   
     482      IF( l_diaptr ) THEN 
    483483         ! 
    484484         IF( dia_ptr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 
    … …  
    489489         IF( lk_mpp )   CALL mpp_ini_znl( numout )     ! Define MPI communicator for zonal sum 
    490490 
    491          btmsk(:,:,1) = tmask_i(:,:)                  
     491         btmsk(:,:,1) = tmask_i(:,:) 
    492492         IF( nbasin == 5 ) THEN   ! nbasin has been initialized in iom_init to define the axis "basin" 
    493493            CALL iom_open( 'subbasins', inum ) 
    … …  
    504504         WHERE( gphit(:,:)*tmask_i(:,:) < -34._wp) 
    505505           zmsk(:,:) = 0._wp      ! mask out Southern Ocean 
    506          ELSE WHERE                   
     506         ELSE WHERE 
    507507           zmsk(:,:) = ssmask(:,:) 
    508508         END WHERE 
    509          btmsk34(:,:,1) = btmsk(:,:,1)                  
     509         btmsk34(:,:,1) = btmsk(:,:,1) 
    510510         DO jn = 2, nbasin 
    511511            btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:)                  ! interior domain only 
    … …  
    514514         ! Initialise arrays to zero because diatpr is called before they are first calculated 
    515515         ! Note that this means diagnostics will not be exactly correct when model run is restarted. 
    516          hstr_adv(:,:,:) = 0._wp            
    517          hstr_ldf(:,:,:) = 0._wp            
    518          hstr_eiv(:,:,:) = 0._wp            
    519          hstr_ove(:,:,:) = 0._wp            
     516         hstr_adv(:,:,:) = 0._wp 
     517         hstr_ldf(:,:,:) = 0._wp 
     518         hstr_eiv(:,:,:) = 0._wp 
     519         hstr_ove(:,:,:) = 0._wp 
    520520         hstr_btr(:,:,:) = 0._wp           ! 
    521521         hstr_vtr(:,:,:) = 0._wp           ! 
    … …  
    525525         ll_init = .FALSE. 
    526526         ! 
    527       ENDIF  
    528       !  
     527      ENDIF 
     528      ! 
    529529   END SUBROUTINE dia_ptr_init 
    530530 
    531531 
    532    SUBROUTINE dia_ptr_hst( ktra, cptr, pvflx )  
     532   SUBROUTINE dia_ptr_hst( ktra, cptr, pvflx ) 
    533533      !!---------------------------------------------------------------------- 
    534534      !!                    ***  ROUTINE dia_ptr_hst *** 
    … …  
    727727      ! 
    728728      INTEGER                  ::   ji,jj,jc       ! dummy loop arguments 
    729       INTEGER                  ::   ijpj        ! ???  
     729      INTEGER                  ::   ijpj        ! ??? 
    730730      REAL(wp), DIMENSION(jpi,jpj) :: p_fval ! function value 
    731731      !!-------------------------------------------------------------------- 
    732       !  
     732      ! 
    733733      ijpj = jpj  ! ??? 
    734734      p_fval(:,:) = 0._wp 
    … …  
    738738         END_2D 
    739739      END DO 
    740       !  
     740      ! 
    741741   END FUNCTION ptr_ci_2d 
    742742 

  • NEMO/trunk/src/OCE/DIU/diu_coolskin.F90

    r13722 r14072  
    2020   USE lib_mpp 
    2121   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    22     
     22 
    2323   IMPLICIT NONE 
    2424   PRIVATE 
    … …  
    3434   REAL(wp), PRIVATE, PARAMETER :: pp_rhoa = 1.20421_wp     ! density of air (at 20C) 
    3535   REAL(wp), PRIVATE, PARAMETER :: pp_cda = 1.45e-3_wp      ! assumed air-sea drag coefficient for calculating wind speed 
    36     
     36 
    3737   ! Key variables 
    3838   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csdsst    ! Cool skin delta SST 
    … …  
    4646   !! $Id$ 
    4747   !! Software governed by the CeCILL license (see ./LICENSE) 
    48    !!----------------------------------------------------------------------    
    49    CONTAINS  
    50     
     48   !!---------------------------------------------------------------------- 
     49   CONTAINS 
     50 
    5151   SUBROUTINE diurnal_sst_coolskin_init 
    5252      !!---------------------------------------------------------------------- 
    … …  
    5555      !! ** Purpose :   initialise the cool skin model 
    5656      !! 
    57       !! ** Method :  
     57      !! ** Method : 
    5858      !! 
    5959      !! ** Reference : 
    60       !!  
     60      !! 
    6161      !!---------------------------------------------------------------------- 
    6262      ALLOCATE( x_csdsst(jpi,jpj), x_csthick(jpi,jpj) ) 
    … …  
    7373      !! ** Purpose :   Time-step the Artale cool skin model 
    7474      !! 
    75       !! ** Method :  
     75      !! ** Method : 
    7676      !! 
    77       !! ** Reference :  
     77      !! ** Reference : 
    7878      !!---------------------------------------------------------------------- 
    7979      ! Dummy variables 
    … …  
    8282      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho       ! Water density (kg/m^3) 
    8383      REAL(wp), INTENT(IN) :: pDt                             ! Time-step 
    84       
     84 
    8585      ! Local variables 
    86       REAL(wp), DIMENSION(jpi,jpj) :: z_fv                    ! Friction velocity      
     86      REAL(wp), DIMENSION(jpi,jpj) :: z_fv                    ! Friction velocity 
    8787      REAL(wp), DIMENSION(jpi,jpj) :: z_gamma                 ! Dimensionless function of wind speed 
    8888      REAL(wp), DIMENSION(jpi,jpj) :: z_lamda                 ! Sauders (dimensionless) proportionality constant 
    … …  
    9191      REAL(wp) :: z_zty                                       ! Temporary v wind stress 
    9292      REAL(wp) :: z_zmod                                      ! Temporary total wind stress 
    93       
     93 
    9494      INTEGER :: ji,jj 
    9595      !!---------------------------------------------------------------------- 
    … …  
    105105         ELSE 
    106106            z_fv(ji,jj) = 0. 
    107             z_wspd(ji,jj) = 0.      
     107            z_wspd(ji,jj) = 0. 
    108108         ENDIF 
    109109         ! 

  • NEMO/trunk/src/OCE/DOM/daymod.F90

    r13970 r14072  
    1919   !!                    ----------- WARNING ----------- 
    2020   !!                    ------------------------------- 
    21    !!   sbcmod assume that the time step is dividing the number of second of  
    22    !!   in a day, i.e. ===> MOD( rday, rn_Dt ) == 0  
     21   !!   sbcmod assume that the time step is dividing the number of second of 
     22   !!   in a day, i.e. ===> MOD( rday, rn_Dt ) == 0 
    2323   !!   except when user defined forcing is used (see sbcmod.F90) 
    2424   !!---------------------------------------------------------------------- 
    … …  
    8484      lrst_oce = .NOT. l_offline   ! force definition of offline 
    8585      IF( lrst_oce )   CALL day_rst( nit000, 'READ' ) 
    86        
     86 
    8787      ! set the calandar from ndastp (read in restart file and namelist) 
    8888      nyear   =   ndastp / 10000 
    … …  
    9494      isecrst = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss) 
    9595 
    96       CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,wp), fjulday )   
     96      CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,wp), fjulday ) 
    9797      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error 
    9898      IF( nhour*NINT(rhhmm*rmmss) + nminute*NINT(rmmss) - ndt05 .LT. 0 ) fjulday = fjulday+1.       ! move back to the day at nit000 (and not at nit000 - 1) 
    … …  
    124124      IF( isecrst - ndt05 .GT. 0 ) THEN 
    125125         ! 1 timestep before current middle of first time step is still the same day 
    126          nsec_year  = (nday_year-1) * nsecd + isecrst - ndt05  
    127          nsec_month = (nday-1)      * nsecd + isecrst - ndt05     
     126         nsec_year  = (nday_year-1) * nsecd + isecrst - ndt05 
     127         nsec_month = (nday-1)      * nsecd + isecrst - ndt05 
    128128      ELSE 
    129          ! 1 time step before the middle of the first time step is the previous day  
    130          nsec_year  = nday_year     * nsecd + isecrst - ndt05  
    131          nsec_month = nday          * nsecd + isecrst - ndt05    
     129         ! 1 time step before the middle of the first time step is the previous day 
     130         nsec_year  = nday_year     * nsecd + isecrst - ndt05 
     131         nsec_month = nday          * nsecd + isecrst - ndt05 
    132132      ENDIF 
    133133      nsec_monday   = imonday       * nsecd + isecrst - ndt05 
    134       nsec_day      =                         isecrst - ndt05  
     134      nsec_day      =                         isecrst - ndt05 
    135135      IF( nsec_day    .LT. 0 ) nsec_day    = nsec_day    + nsecd 
    136136      IF( nsec_monday .LT. 0 ) nsec_monday = nsec_monday + nsecd*7 
    … …  
    144144      nsec000_1jan000 = nsec1jan000 + nsec_year + ndt05 
    145145      nsecend_1jan000 = nsec000_1jan000 + ndt * ( nitend - nit000 + 1 ) 
    146        
     146 
    147147      ! Up to now, calendar parameters are related to the end of previous run (nit000-1) 
    148148      ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init 
    … …  
    344344               ! calculate start time in hours and minutes 
    345345               zdayfrac = adatrj - REAL(INT(adatrj), wp) 
    346           ksecs = NINT(zdayfrac * rday)          ! Nearest second to catch rounding errors in adatrj          
     346          ksecs = NINT(zdayfrac * rday)          ! Nearest second to catch rounding errors in adatrj 
    347347               ihour = ksecs / NINT( rhhmm*rmmss ) 
    348348          iminute = ksecs / NINT(rmmss) - ihour*NINT(rhhmm) 
    349             
     349 
    350350               ! Add to nn_time0 
    351351               nhour   =   nn_time0 / 100 
    352352               nminute = ( nn_time0 - nhour * 100 ) 
    353353          nminute = nminute + iminute 
    354            
     354 
    355355               IF( nminute >= NINT(rhhmm) ) THEN 
    356356             nminute = nminute - NINT(rhhmm) 
    … …  
    361361        nhour = nhour - NINT(rjjhh) 
    362362             adatrj = adatrj + 1. 
    363           ENDIF           
     363          ENDIF 
    364364          nn_time0 = nhour * 100 + nminute 
    365                adatrj = REAL(INT(adatrj), wp)                    ! adatrj set to integer as nn_time0 updated           
     365               adatrj = REAL(INT(adatrj), wp)                    ! adatrj set to integer as nn_time0 updated 
    366366            ELSE 
    367367               ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) 

  • NEMO/trunk/src/OCE/DOM/dom_oce.F90

    r14053 r14072  
    44   !! ** Purpose :   Define in memory all the ocean space domain variables 
    55   !!====================================================================== 
    6    !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate  
     6   !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate 
    77   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level 
    88   !!            3.4  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    … …  
    7272   !                                !  = 6 cyclic East-West AND North fold F-point pivot 
    7373   !                                !  = 7 bi-cyclic East-West AND North-South 
    74    LOGICAL, PUBLIC ::   l_Iperio, l_Jperio   !   should we explicitely take care I/J periodicity  
     74   LOGICAL, PUBLIC ::   l_Iperio, l_Jperio   !   should we explicitely take care I/J periodicity 
    7575 
    7676   ! Tiling namelist 
    … …  
    9191   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy(:)    !: mark i-direction local boundaries for BDY open boundaries 
    9292   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy(:)    !: mark j-direction local boundaries for BDY open boundaries 
    93    INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries   
    94    INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries   
     93   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries 
     94   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries 
    9595 
    9696   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4) 
    9797   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in 
    9898   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions 
    99    INTEGER, PUBLIC ::   nones, nonws        !: north-east, north-west directions for sending  
     99   INTEGER, PUBLIC ::   nones, nonws        !: north-east, north-west directions for sending 
    100100   INTEGER, PUBLIC ::   noses, nosws        !: south-east, south-west directions for sending 
    101101   INTEGER, PUBLIC ::   noner, nonwr        !: north-east, north-west directions for receiving 
    … …  
    142142   LOGICAL, PUBLIC ::   ln_zps       !: z-coordinate - partial step 
    143143   LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate 
    144    LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF  
     144   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF 
    145145   !                                                        !  reference scale factors 
    146146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0   !: t- vert. scale factor [m] 
    … …  
    166166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gde3w_0  !: w- depth (sum of e3w) [m] 
    167167   !                                                        !  time-dependent depths of cells 
    168    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw   
    169    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gde3w   
    170     
     168   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw 
     169   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gde3w 
     170 
    171171   !                                                        !  reference heights of ocean water column and its inverse 
    172172   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   ht_0, r1_ht_0   !: t-depth        [m] and [1/m] 
    … …  
    182182 
    183183   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
    184    INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1)  
     184   INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1) 
    185185 
    186186   !! 1D reference  vertical coordinate 
    … …  
    207207   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET ::   tmask, umask, vmask, wmask, fmask   !: land/ocean mask at T-, U-, V-, W- and F-pts 
    208208   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET ::   wumask, wvmask                      !: land/ocean mask at WU- and WV-pts 
    209 #if defined key_qco    
     209#if defined key_qco 
    210210   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET ::   fe3mask                             !: land/ocean mask at F-pts for qco 
    211211#endif 
    … …  
    224224   INTEGER , PUBLIC ::   nsec_monday   !: seconds between 00h         of the last Monday   and half of the current time step 
    225225   INTEGER , PUBLIC ::   nsec_day      !: seconds between 00h         of the current   day and half of the current time step 
    226    REAL(wp), PUBLIC ::   fjulday       !: current julian day  
     226   REAL(wp), PUBLIC ::   fjulday       !: current julian day 
    227227   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days 
    228228   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation 
    … …  
    252252   !!---------------------------------------------------------------------- 
    253253   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    254    !! $Id$  
     254   !! $Id$ 
    255255   !! Software governed by the CeCILL license (see ./LICENSE) 
    256256   !!---------------------------------------------------------------------- 
    … …  
    270270 
    271271   CHARACTER(len=3) FUNCTION Agrif_CFixed() 
    272       Agrif_CFixed = '0'  
     272      Agrif_CFixed = '0' 
    273273   END FUNCTION Agrif_CFixed 
    274274#endif 
    … …  
    311311      ii = ii+1 
    312312      ALLOCATE( r3t  (jpi,jpj,jpt)   , r3u  (jpi,jpj,jpt)    , r3v  (jpi,jpj,jpt)    , r3f  (jpi,jpj) ,      & 
    313          &      r3t_f(jpi,jpj)       , r3u_f(jpi,jpj)        , r3v_f(jpi,jpj)                         ,  STAT=ierr(ii) )              
     313         &      r3t_f(jpi,jpj)       , r3u_f(jpi,jpj)        , r3v_f(jpi,jpj)                         ,  STAT=ierr(ii) ) 
    314314#else 
    315315      ii = ii+1 

  • NEMO/trunk/src/OCE/DOM/domain.F90

    r14053 r14072  
    66   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code 
    77   !!                 !  1992-01  (M. Imbard) insert time step initialization 
    8    !!                 !  1996-06  (G. Madec) generalized vertical coordinate  
     8   !!                 !  1996-06  (G. Madec) generalized vertical coordinate 
    99   !!                 !  1997-02  (G. Madec) creation of domwri.F 
    1010   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea 
    … …  
    1717   !!            4.1  !  2020-02  (G. Madec, S. Techene)  introduce ssh to h0 ratio 
    1818   !!---------------------------------------------------------------------- 
    19     
     19 
    2020   !!---------------------------------------------------------------------- 
    2121   !!   dom_init      : initialize the space and time domain 
    … …  
    3333   USE domvvl         ! variable volume 
    3434#endif 
    35    USE sshwzv  , ONLY : ssh_init_rst   ! set initial ssh  
     35   USE sshwzv  , ONLY : ssh_init_rst   ! set initial ssh 
    3636   USE sbc_oce        ! surface boundary condition: ocean 
    3737   USE trc_oce        ! shared ocean & passive tracers variab 
    … …  
    7272      !!---------------------------------------------------------------------- 
    7373      !!                  ***  ROUTINE dom_init  *** 
    74       !!                     
    75       !! ** Purpose :   Domain initialization. Call the routines that are  
    76       !!              required to create the arrays which define the space  
     74      !! 
     75      !! ** Purpose :   Domain initialization. Call the routines that are 
     76      !!              required to create the arrays which define the space 
    7777      !!              and time domain of the ocean model. 
    7878      !! 
    … …  
    8989      INTEGER ::   iconf = 0    ! local integers 
    9090      REAL(wp)::   zrdt 
    91       CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))"  
     91      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
    9292      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level 
    9393      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0 
    … …  
    126126         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg 
    127127      ENDIF 
    128        
     128 
    129129      ! 
    130130      !           !==  Reference coordinate system  ==! 
    … …  
    240240         WRITE(numout,*) 'dom_init :   ==>>>   END of domain initialization' 
    241241         WRITE(numout,*) '~~~~~~~~' 
    242          WRITE(numout,*)  
     242         WRITE(numout,*) 
    243243      ENDIF 
    244244      ! 
    … …  
    252252      !! ** Purpose :   initialization of global domain <--> local domain indices 
    253253      !! 
    254       !! ** Method  :    
     254      !! ** Method  : 
    255255      !! 
    256256      !! ** Action  : - mig , mjg : local  domain indices ==> global domain, including halos, indices 
    … …  
    271271      ! 
    272272      mig0(:) = mig(:) - nn_hls 
    273       mjg0(:) = mjg(:) - nn_hls   
    274       ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,  
     273      mjg0(:) = mjg(:) - nn_hls 
     274      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 
    275275      ! we must define mig0 and mjg0 as bellow. 
    276276      ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: 
    … …  
    279279      ! 
    280280      !                              ! global domain, including halos, indices ==> local domain indices 
    281       !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the  
    282       !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.  
     281      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 
     282      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 
    283283      DO ji = 1, jpiglo 
    284284        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) ) 
    … …  
    387387      !!---------------------------------------------------------------------- 
    388388      !!                     ***  ROUTINE dom_nam  *** 
    389       !!                     
     389      !! 
    390390      !! ** Purpose :   read domaine namelists and print the variables. 
    391391      !! 
    … …  
    549549         ! 
    550550         IF( .NOT.l_SAS .AND. iom_varid( numror, 'sshb', ldstop = .FALSE. ) <= 0 ) THEN   !- Check absence of one of the Kbb field (here sshb) 
    551             !                                                                             !  (any Kbb field is missing ==> all Kbb fields are missing)  
     551            !                                                                             !  (any Kbb field is missing ==> all Kbb fields are missing) 
    552552            IF( .NOT.l_1st_euler ) THEN 
    553553               CALL ctl_warn('dom_nam : ssh at Kbb not found in restart files ',   & 
    … …  
    558558         ENDIF 
    559559      ELSEIF( .NOT.l_1st_euler ) THEN                   !*  Initialization case 
    560          IF(lwp) WRITE(numout,*)   
     560         IF(lwp) WRITE(numout,*) 
    561561         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)' 
    562          IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : l_1st_euler is forced to .true. '    
     562         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : l_1st_euler is forced to .true. ' 
    563563         l_1st_euler = .TRUE. 
    564564      ENDIF 
    … …  
    586586         IF(lwp) WRITE(numout,*) 
    587587         SELECT CASE ( nleapy )                !==  Choose calendar for IOIPSL  ==! 
    588          CASE (  1 )  
     588         CASE (  1 ) 
    589589            CALL ioconf_calendar('gregorian') 
    590590            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year' 
    … …  
    699699      !!---------------------------------------------------------------------- 
    700700      !!                     ***  ROUTINE domain_cfg  *** 
    701       !!                     
     701      !! 
    702702      !! ** Purpose :   read the domain size in domain configuration file 
    703703      !! 
    … …  
    706706      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name 
    707707      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution 
    708       INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes  
    709       INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.  
     708      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
     709      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
    710710      ! 
    711711      INTEGER ::   inum   ! local integer 
    … …  
    739739         cd_cfg = 'UNKNOWN' 
    740740         kk_cfg = -9999999 
    741                                           !- or they may be present as global attributes  
    742                                           !- (netcdf only)   
     741                                          !- or they may be present as global attributes 
     742                                          !- (netcdf only) 
    743743         CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found 
    744744         CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found 
    … …  
    762762         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio 
    763763      ENDIF 
    764       !         
     764      ! 
    765765   END SUBROUTINE domain_cfg 
    766     
    767     
     766 
     767 
    768768   SUBROUTINE cfg_write 
    769769      !!---------------------------------------------------------------------- 
    770770      !!                  ***  ROUTINE cfg_write  *** 
    771       !!                    
    772       !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which  
    773       !!              contains all the ocean domain informations required to  
     771      !! 
     772      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which 
     773      !!              contains all the ocean domain informations required to 
    774774      !!              define an ocean configuration. 
    775775      !! 
    … …  
    777777      !!              ocean configuration. 
    778778      !! 
    779       !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal  
     779      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal 
    780780      !!                       mesh, Coriolis parameter, and vertical scale factors 
    781781      !!                    NB: also contain ORCA family information 
    … …  
    794794      !                       !  create 'domcfg_out.nc' file  ! 
    795795      !                       ! ============================= ! 
    796       !          
     796      ! 
    797797      clnam = cn_domcfg_out  ! filename (configuration information) 
    798       CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )      
     798      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 
    799799      ! 
    800800      !                             !==  ORCA family specificities  ==! 
    801801      IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN 
    802802         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 ) 
    803          CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )          
     803         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 
    804804      ENDIF 
    805805      ! 
    … …  
    823823      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 ) 
    824824      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 ) 
    825       !                                 
     825      ! 
    826826      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude 
    827827      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 ) 
    828828      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 ) 
    829829      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 ) 
    830       !                                 
     830      ! 
    831831      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.) 
    832832      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 ) 
    … …  
    843843      ! 
    844844      !                             !==  vertical mesh  ==! 
    845       !                                                      
     845      ! 
    846846      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate 
    847847      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 ) 
    … …  
    854854      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 ) 
    855855      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 ) 
    856       !                                          
     856      ! 
    857857      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask) 
    858858      ! 
    … …  
    874874      ! 
    875875      !                                ! ============================ 
    876       !                                !        close the files  
     876      !                                !        close the files 
    877877      !                                ! ============================ 
    878878      CALL iom_close( inum ) 

  • NEMO/trunk/src/OCE/DOM/domutl.F90

    r13982 r14072  
    3131   !!---------------------------------------------------------------------- 
    3232   !! NEMO/OCE 4.2 , NEMO Consortium (2020) 
    33    !! $Id$  
     33   !! $Id$ 
    3434   !! Software governed by the CeCILL license (see ./LICENSE) 
    3535   !!---------------------------------------------------------------------- 
    … …  
    4242      !! ** Purpose :   find the closest grid point from a given lon/lat position 
    4343      !! 
    44       !! ** Method  :   look for minimum distance in cylindrical projection  
     44      !! ** Method  :   look for minimum distance in cylindrical projection 
    4545      !!                -> not good if located at too high latitude... 
    4646      !!---------------------------------------------------------------------- 
    … …  
    8686      !!---------------------------------------------------------------------- 
    8787      !!                  ***  ROUTINE dom_uniq  *** 
    88       !!                    
     88      !! 
    8989      !! ** Purpose :   identify unique point of a grid (TUVF) 
    9090      !! 
    … …  
    9292      !!                2) check which elements have been changed 
    9393      !!---------------------------------------------------------------------- 
    94       CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
    95       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  
     94      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   ! 
     95      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   ! 
    9696      ! 
    9797      REAL(wp)                       ::  zshift   ! shift value link to the process number 
    … …  
    101101      !!---------------------------------------------------------------------- 
    102102      ! 
    103       ! build an array with different values for each element  
     103      ! build an array with different values for each element 
    104104      ! in mpp: make sure that these values are different even between process 
    105105      ! -> apply a shift value according to the process number 
    … …  
    109109      puniq(:,:) = ztstref(:,:)                    ! default definition 
    110110      CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. )   ! apply boundary conditions 
    111       lluniq(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have not been changed  
     111      lluniq(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have not been changed 
    112112      ! 
    113113      puniq(:,:) = REAL( COUNT( lluniq(:,:,:), dim = 3 ), wp ) 

  • NEMO/trunk/src/OCE/DOM/domvvl.F90

    r14053 r14072  
    22   !!====================================================================== 
    33   !!                       ***  MODULE domvvl   *** 
    4    !! Ocean :  
     4   !! Ocean : 
    55   !!====================================================================== 
    66   !! History :  2.0  !  2006-06  (B. Levier, L. Marie)  original code 
    … …  
    5858   !!   Default key      Old management of time varying vertical coordinate 
    5959   !!---------------------------------------------------------------------- 
    60     
     60 
    6161   !!---------------------------------------------------------------------- 
    6262   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
    … …  
    7373   PUBLIC  dom_vvl_sf_update  ! called by step.F90 
    7474   PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
    75     
     75 
    7676   !! * Substitutions 
    7777#  include "do_loop_substitute.h90" 
    … …  
    109109      !!---------------------------------------------------------------------- 
    110110      !!                ***  ROUTINE dom_vvl_init  *** 
    111       !!                    
     111      !! 
    112112      !! ** Purpose :  Initialization of all scale factors, depths 
    113113      !!               and water column heights 
    … …  
    118118      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b) 
    119119      !!              - Regrid: e3[u/v](:,:,:,Kmm) 
    120       !!                        e3[u/v](:,:,:,Kmm)        
    121       !!                        e3w(:,:,:,Kmm)            
     120      !!                        e3[u/v](:,:,:,Kmm) 
     121      !!                        e3w(:,:,:,Kmm) 
    122122      !!                        e3[u/v]w_b 
    123       !!                        e3[u/v]w_n       
     123      !!                        e3[u/v]w_n 
    124124      !!                        gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 
    125125      !!              - h(t/u/v)_0 
    … …  
    151151      !!---------------------------------------------------------------------- 
    152152      !!                ***  ROUTINE dom_vvl_init  *** 
    153       !!                    
    154       !! ** Purpose :  Interpolation of all scale factors,  
     153      !! 
     154      !! ** Purpose :  Interpolation of all scale factors, 
    155155      !!               depths and water column heights 
    156156      !! 
    … …  
    159159      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b) 
    160160      !!              - Regrid: e3(u/v)_n 
    161       !!                        e3(u/v)_b        
    162       !!                        e3w_n            
    163       !!                        e3(u/v)w_b       
    164       !!                        e3(u/v)w_n       
     161      !!                        e3(u/v)_b 
     162      !!                        e3w_n 
     163      !!                        e3(u/v)w_b 
     164      !!                        e3(u/v)w_n 
    165165      !!                        gdept_n, gdepw_n and gde3w_n 
    166166      !!              - h(t/u/v)_0 
    … …  
    180180      CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' )    ! from T to U 
    181181      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 
    182       CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )    ! from T to V  
     182      CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )    ! from T to V 
    183183      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 
    184184      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' )    ! from U to F 
    185       !                                ! Vertical interpolation of e3t,u,v  
     185      !                                ! Vertical interpolation of e3t,u,v 
    186186      CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  )  ! from T to W 
    187187      CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3w (:,:,:,Kbb), 'W'  ) 
    … …  
    205205         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    206206         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
    207          !                             ! 0.5 where jk = mikt      
     207         !                             ! 0.5 where jk = mikt 
    208208!!gm ???????   BUG ?  gdept(:,:,:,Kmm) as well as gde3w  does not include the thickness of ISF ?? 
    209209         zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 
    210210         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    211211         gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  & 
    212             &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm))  
     212            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm)) 
    213213         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    214214         gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 
    215215         gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  & 
    216             &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb))  
     216            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb)) 
    217217      END_3D 
    218218      ! 
    … …  
    273273            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    274274               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    275                   ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1       
     275                  ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1 
    276276                  ij0 = 128 + nn_hls       ;   ij1 = 135 + nn_hls 
    277277                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    … …  
    285285 
    286286 
    287    SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall )  
     287   SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 
    288288      !!---------------------------------------------------------------------- 
    289289      !!                ***  ROUTINE dom_vvl_sf_nxt  *** 
    290       !!                    
     290      !! 
    291291      !! ** Purpose :  - compute the after scale factors used in tra_zdf, dynnxt, 
    292292      !!                 tranxt and dynspg routines 
    293293      !! 
    294294      !! ** Method  :  - z_star case:  Repartition of ssh INCREMENT proportionnaly to the level thickness. 
    295       !!               - z_tilde_case: after scale factor increment =  
     295      !!               - z_tilde_case: after scale factor increment = 
    296296      !!                                    high frequency part of horizontal divergence 
    297297      !!                                  + retsoring towards the background grid 
    … …  
    301301      !! 
    302302      !! ** Action  :  - hdiv_lf    : restoring towards full baroclinic divergence in z_tilde case 
    303       !!               - tilde_e3t_a: after increment of vertical scale factor  
     303      !!               - tilde_e3t_a: after increment of vertical scale factor 
    304304      !!                              in z_tilde case 
    305305      !!               - e3(t/u/v)_a 
    … …  
    405405            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
    406406               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
    407             vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           &  
     407            vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
    408408               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
    409409            zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
    … …  
    450450               WRITE(numout, *) 'at i, j, k=', ijk_max 
    451451               WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 
    452                WRITE(numout, *) 'at i, j, k=', ijk_min             
     452               WRITE(numout, *) 'at i, j, k=', ijk_min 
    453453               CALL ctl_stop( 'STOP', 'MAX( ABS( tilde_e3t_a(:,:,: ) ) / e3t_0(:,:,:) ) too high') 
    454454            ENDIF 
    … …  
    566566      !!---------------------------------------------------------------------- 
    567567      !!                ***  ROUTINE dom_vvl_sf_update  *** 
    568       !!                    
    569       !! ** Purpose :  for z tilde case: compute time filter and swap of scale factors  
     568      !! 
     569      !! ** Purpose :  for z tilde case: compute time filter and swap of scale factors 
    570570      !!               compute all depths and related variables for next time step 
    571571      !!               write outputs and restart file 
    … …  
    577577      !! ** Action  :  - tilde_e3t_(b/n) ready for next time step 
    578578      !!               - Recompute: 
    579       !!                    e3(u/v)_b        
    580       !!                    e3w(:,:,:,Kmm)            
    581       !!                    e3(u/v)w_b       
    582       !!                    e3(u/v)w_n       
     579      !!                    e3(u/v)_b 
     580      !!                    e3w(:,:,:,Kmm) 
     581      !!                    e3(u/v)w_b 
     582      !!                    e3(u/v)w_n 
    583583      !!                    gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm)  and gde3w 
    584584      !!                    h(u/v) and h(u/v)r 
    … …  
    611611            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 
    612612         ELSE 
    613             tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) &  
     613            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 
    614614            &         + rn_atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 
    615615         ENDIF 
    … …  
    623623      ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 
    624624      ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
    625        
     625 
    626626      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F'  ) 
    627        
     627 
    628628      ! Vertical scale factor interpolations 
    629629      CALL dom_vvl_interpol( e3t(:,:,:,Kmm),  e3w(:,:,:,Kmm), 'W'  ) 
    … …  
    644644         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    645645         gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  & 
    646              &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) )  
     646             &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) ) 
    647647         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    648648      END_3D 
    … …  
    763763      !!--------------------------------------------------------------------- 
    764764      !!                   ***  ROUTINE dom_vvl_rst  *** 
    765       !!                      
     765      !! 
    766766      !! ** Purpose :   Read or write VVL file in restart file 
    767767      !! 
    … …  
    807807            IF(lwp) WRITE(numout,*)    '          Kmm scale factor read in the restart file' 
    808808            CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    809             WHERE ( tmask(:,:,:) == 0.0_wp )  
     809            WHERE ( tmask(:,:,:) == 0.0_wp ) 
    810810               e3t(:,:,:,Kmm) = e3t_0(:,:,:) 
    811811            END WHERE 
    … …  
    816816               IF(lwp) WRITE(numout,*) '          Kbb scale factor read in the restart file' 
    817817               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
    818                WHERE ( tmask(:,:,:) == 0.0_wp )  
     818               WHERE ( tmask(:,:,:) == 0.0_wp ) 
    819819                  e3t(:,:,:,Kbb) = e3t_0(:,:,:) 
    820820               END WHERE 
    … …  
    840840                     CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
    841841                  ENDIF 
    842                ELSE  
     842               ELSE 
    843843                  tilde_e3t_b(:,:,:) = 0.0_wp 
    844844                  tilde_e3t_n(:,:,:) = 0.0_wp 
    … …  
    850850                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 
    851851                  ELSE                ! array is missing 
    852                      hdiv_lf(:,:,:) = 0.0_wp  
     852                     hdiv_lf(:,:,:) = 0.0_wp 
    853853                  ENDIF 
    854854               ENDIF 
    … …  
    884884            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 
    885885         END IF 
    886          !                                           ! -------------!     
     886         !                                           ! -------------! 
    887887         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    888888            !                                        ! ------------ ! 
    … …  
    898898      !!--------------------------------------------------------------------- 
    899899      !!                  ***  ROUTINE dom_vvl_ctl  *** 
    900       !!                 
     900      !! 
    901901      !! ** Purpose :   Control the consistency between namelist options 
    902902      !!                for vertical coordinate 
    … …  
    907907         &              ln_vvl_zstar_at_eqtor      , rn_ahe3     , rn_rst_e3t            , & 
    908908         &              rn_lf_cutoff               , rn_zdef_max , ln_vvl_dbg                ! not yet implemented: ln_vvl_kepe 
    909       !!----------------------------------------------------------------------  
     909      !!---------------------------------------------------------------------- 
    910910      ! 
    911911      READ  ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901) 

  • NEMO/trunk/src/OCE/DOM/dtatsd.F90

    r13982 r14072  
    66   !! History :  OPA  ! 1991-03  ()  Original code 
    77   !!             -   ! 1992-07  (M. Imbard) 
    8    !!            8.0  ! 1999-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT  
    9    !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module  
     8   !!            8.0  ! 1999-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT 
     9   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
    1010   !!            3.3  ! 2010-10  (C. Bricaud, S. Masson)  use of fldread 
    1111   !!            3.4  ! 2010-11  (G. Madec, C. Ethe) Merge of dtatem and dtasal + remove CPP keys 
    … …  
    4040   !!---------------------------------------------------------------------- 
    4141   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    42    !! $Id$  
     42   !! $Id$ 
    4343   !! Software governed by the CeCILL license (see ./LICENSE) 
    4444   !!---------------------------------------------------------------------- 
    … …  
    4848      !!---------------------------------------------------------------------- 
    4949      !!                   ***  ROUTINE dta_tsd_init  *** 
    50       !!                     
    51       !! ** Purpose :   initialisation of T & S input data  
    52       !!  
     50      !! 
     51      !! ** Purpose :   initialisation of T & S input data 
     52      !! 
    5353      !! ** Method  : - Read namtsd namelist 
    54       !!              - allocates T & S data structure  
     54      !!              - allocates T & S data structure 
    5555      !!---------------------------------------------------------------------- 
    5656      LOGICAL, INTENT(in), OPTIONAL ::   ld_tradmp   ! force the initialization when tradp is used 
    … …  
    7575 
    7676      IF( PRESENT( ld_tradmp ) )   ln_tsd_dmp = .TRUE.     ! forces the initialization when tradmp is used 
    77        
     77 
    7878      IF(lwp) THEN                  ! control print 
    7979         WRITE(numout,*) 
    … …  
    124124      !!---------------------------------------------------------------------- 
    125125      !!                   ***  ROUTINE dta_tsd  *** 
    126       !!                     
     126      !! 
    127127      !! ** Purpose :   provides T and S data at kt 
    128       !!  
     128      !! 
    129129      !! ** Method  : - call fldread routine 
    130       !!              - ORCA_R2: add some hand made alteration to read data   
     130      !!              - ORCA_R2: add some hand made alteration to read data 
    131131      !!              - 'key_orca_lev10' interpolates on 10 times more levels 
    132132      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh 
    … …  
    211211                     IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    212212                        zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
    213                         ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi  
     213                        ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 
    214214                        zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 
    215215                     ENDIF 
    … …  
    224224            ptsd(ji,jj,jpk,jp_sal) = 0._wp 
    225225         END_2D 
    226          !  
     226         ! 
    227227      ELSE                                !==   z- or zps- coordinate   ==! 
    228          !                              
     228         ! 
    229229         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    230230            ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)    ! Mask 
    … …  
    235235            ! NOTE: [tiling-comms-merge] This fix was necessary to take out tra_adv lbc_lnk statements in the zps case 
    236236            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    237                ik = mbkt(ji,jj)  
     237               ik = mbkt(ji,jj) 
    238238               IF( ik > 1 ) THEN 
    239239                  zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    … …  
    243243               ik = mikt(ji,jj) 
    244244               IF( ik > 1 ) THEN 
    245                   zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )  
     245                  zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
    246246                  ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 
    247247                  ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) 
    … …  
    252252      ENDIF 
    253253      ! 
    254       IF( .NOT.ln_tsd_dmp ) THEN                   !==   deallocate T & S structure   ==!  
     254      IF( .NOT.ln_tsd_dmp ) THEN                   !==   deallocate T & S structure   ==! 
    255255         !                                              (data used only for initialisation) 
    256256         IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run' 

  • NEMO/trunk/src/OCE/DOM/phycst.F90

    r14053 r14072  
    77   !!             8.1  !  1991-11  (G. Madec, M. Imbard)  cosmetic changes 
    88   !!   NEMO      1.0  !  2002-08  (G. Madec, C. Ethe)  F90, add ice constants 
    9    !!              -   !  2006-08  (G. Madec)  style  
    10    !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style  
    11    !!             3.4  !  2011-11  (C. Harris)  minor changes for CICE constants  
     9   !!              -   !  2006-08  (G. Madec)  style 
     10   !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style 
     11   !!             3.4  !  2011-11  (C. Harris)  minor changes for CICE constants 
    1212   !!---------------------------------------------------------------------- 
    1313 
    … …  
    2626   REAL(wp), PUBLIC ::   rad      = 3.141592653589793_wp / 180._wp   !: conversion from degre into radian 
    2727   REAL(wp), PUBLIC ::   rsmall   = 0.5 * EPSILON( 1.e0 )            !: smallest real computer value 
    28     
     28 
    2929   REAL(wp), PUBLIC ::   rday     = 24.*60.*60.      !: day                                [s] 
    3030   REAL(wp), PUBLIC ::   rsiyea                      !: sideral year                       [s] 
    … …  
    3636   REAL(wp), PUBLIC ::   omega                       !: earth rotation parameter           [s-1] 
    3737   REAL(wp), PUBLIC ::   ra       = 6371229._wp      !: earth radius                       [m] 
    38    REAL(wp), PUBLIC ::   grav     = 9.80665_wp       !: gravity                            [m/s2]    
     38   REAL(wp), PUBLIC ::   grav     = 9.80665_wp       !: gravity                            [m/s2] 
    3939   REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin] 
    4040 
    … …  
    4343   REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin] 
    4444   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J] 
    45    REAL(wp), PUBLIC ::   rho0_rcp                    !: = rho0 * rcp  
     45   REAL(wp), PUBLIC ::   rho0_rcp                    !: = rho0 * rcp 
    4646   REAL(wp), PUBLIC ::   r1_rho0_rcp                 !: = 1. / ( rho0 * rcp ) 
    4747 
    … …  
    5252   REAL(wp), PUBLIC ::   rLevap   =    2.5e+6_wp     !: latent heat of evaporation (water) 
    5353   REAL(wp), PUBLIC ::   vkarmn   =    0.4_wp        !: von Karman constant 
    54    REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant  
     54   REAL(wp), PUBLIC ::   vkarmn2  =    0.4_wp*0.4_wp !: square of von Karman constant 
     55   REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant 
    5556 
    5657   REAL(wp), PUBLIC ::   rhos     =  330._wp         !: volumic mass of snow                                  [kg/m3] 
    … …  
    6667   REAL(wp), PUBLIC ::   r1_rhos                     !: 1 / rhos 
    6768   REAL(wp), PUBLIC ::   r1_rcpi                     !: 1 / rcpi 
    68     
     69 
    6970   !!---------------------------------------------------------------------- 
    7071   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    71    !! $Id$  
     72   !! $Id$ 
    7273   !! Software governed by the CeCILL license (see ./LICENSE) 
    7374   !!---------------------------------------------------------------------- 
    74     
     75 
    7576CONTAINS 
    76     
     77 
    7778   SUBROUTINE phy_cst 
    7879      !!---------------------------------------------------------------------- 
    … …  
    8788      omega  = 7.292116e-05 
    8889#else 
    89       omega  = 2._wp * rpi / rsiday  
     90      omega  = 2._wp * rpi / rsiday 
    9091#endif 
    9192 
    … …  
    126127         WRITE(numout,*) '      salinity of ice (for pisces)              = ', sice    , ' psu' 
    127128         WRITE(numout,*) '      salinity of sea (for pisces and isf)      = ', soce    , ' psu' 
    128          WRITE(numout,*) '      latent heat of evaporation (water)        = ', rLevap  , ' J/m^3'  
    129          WRITE(numout,*) '      von Karman constant                       = ', vkarmn  
     129         WRITE(numout,*) '      latent heat of evaporation (water)        = ', rLevap  , ' J/m^3' 
     130         WRITE(numout,*) '      von Karman constant                       = ', vkarmn 
    130131         WRITE(numout,*) '      Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4' 
    131132         WRITE(numout,*) 

  • NEMO/trunk/src/OCE/DYN/dynatf.F90

    r13472 r14072  
    1313   !!             -   !  2002-10  (C. Talandier, A-M. Treguier) Open boundary cond. 
    1414   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization 
    15    !!            2.3  !  2007-07  (D. Storkey) Calls to BDY routines.  
     15   !!            2.3  !  2007-07  (D. Storkey) Calls to BDY routines. 
    1616   !!            3.2  !  2009-06  (G. Madec, R.Benshila)  re-introduce the vvl option 
    1717   !!            3.3  !  2010-09  (D. Storkey, E.O'Dea) Bug fix for BDY module 
    … …  
    2222   !!            4.1  !  2019-08  (A. Coward, D. Storkey) Rename dynnxt.F90 -> dynatf.F90. Now just does time filtering. 
    2323   !!------------------------------------------------------------------------- 
    24    
     24 
    2525   !!---------------------------------------------------------------------------------------------- 
    2626   !!   dyn_atf       : apply Asselin time filtering to "now" velocities and vertical scale factors 
    … …  
    4242   USE trdken         ! trend manager: kinetic energy 
    4343   USE isf_oce   , ONLY: ln_isf     ! ice shelf 
    44    USE isfdynatf , ONLY: isf_dynatf ! ice shelf volume filter correction subroutine  
     44   USE isfdynatf , ONLY: isf_dynatf ! ice shelf volume filter correction subroutine 
    4545   ! 
    4646   USE in_out_manager ! I/O manager 
    … …  
    8181   !!---------------------------------------------------------------------- 
    8282   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    83    !! $Id$  
     83   !! $Id$ 
    8484   !! Software governed by the CeCILL license (see ./LICENSE) 
    8585   !!---------------------------------------------------------------------- 
    … …  
    8989      !!---------------------------------------------------------------------- 
    9090      !!                  ***  ROUTINE dyn_atf  *** 
    91       !!                    
    92       !! ** Purpose :   Finalize after horizontal velocity. Apply the boundary  
     91      !! 
     92      !! ** Purpose :   Finalize after horizontal velocity. Apply the boundary 
    9393      !!             condition on the after velocity and apply the Asselin time 
    9494      !!             filter to the now fields. 
    … …  
    9797      !!             estimate (ln_dynspg_ts=T) 
    9898      !! 
    99       !!              * Apply lateral boundary conditions on after velocity  
     99      !!              * Apply lateral boundary conditions on after velocity 
    100100      !!             at the local domain boundaries through lbc_lnk call, 
    101101      !!             at the one-way open boundaries (ln_bdy=T), 
    … …  
    104104      !!              * Apply the Asselin time filter to the now fields 
    105105      !!             arrays to start the next time step: 
    106       !!                (puu(Kmm),pvv(Kmm)) = (puu(Kmm),pvv(Kmm))  
     106      !!                (puu(Kmm),pvv(Kmm)) = (puu(Kmm),pvv(Kmm)) 
    107107      !!                                    + rn_atfp [ (puu(Kbb),pvv(Kbb)) + (puu(Kaa),pvv(Kaa)) - 2 (puu(Kmm),pvv(Kmm)) ] 
    108108      !!             Note that with flux form advection and non linear free surface, 
    … …  
    110110      !!             As a result, dyn_atf MUST be called after tra_atf. 
    111111      !! 
    112       !! ** Action :   puu(Kmm),pvv(Kmm)   filtered now horizontal velocity  
     112      !! ** Action :   puu(Kmm),pvv(Kmm)   filtered now horizontal velocity 
    113113      !!---------------------------------------------------------------------- 
    114114      INTEGER                             , INTENT(in   ) :: kt               ! ocean time-step index 
    … …  
    122122      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve, zwfld 
    123123      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zutau, zvtau 
    124       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3t_f, ze3u_f, ze3v_f, zua, zva  
     124      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3t_f, ze3u_f, ze3v_f, zua, zva 
    125125      !!---------------------------------------------------------------------- 
    126126      ! 
    … …  
    150150         ! 
    151151         IF( .NOT.ln_bt_fw ) THEN 
    152             ! Remove advective velocity from "now velocities"  
    153             ! prior to asselin filtering      
    154             ! In the forward case, this is done below after asselin filtering    
    155             ! so that asselin contribution is removed at the same time  
     152            ! Remove advective velocity from "now velocities" 
     153            ! prior to asselin filtering 
     154            ! In the forward case, this is done below after asselin filtering 
     155            ! so that asselin contribution is removed at the same time 
    156156            DO jk = 1, jpkm1 
    157157               puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm) + uu_b(:,:,Kmm) )*umask(:,:,jk) 
    158158               pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm) + vv_b(:,:,Kmm) )*vmask(:,:,jk) 
    159             END DO   
     159            END DO 
    160160         ENDIF 
    161161      ENDIF 
    162162 
    163163      ! Update after velocity on domain lateral boundaries 
    164       ! --------------------------------------------------       
     164      ! -------------------------------------------------- 
    165165# if defined key_agrif 
    166166      CALL Agrif_dyn( kt )             !* AGRIF zoom boundaries 
    … …  
    194194      ! Time filter and swap of dynamics arrays 
    195195      ! ------------------------------------------ 
    196           
    197       IF( .NOT. l_1st_euler ) THEN    !* Leap-Frog : Asselin time filter  
     196 
     197      IF( .NOT. l_1st_euler ) THEN    !* Leap-Frog : Asselin time filter 
    198198         !                                ! =============! 
    199199         IF( ln_linssh ) THEN             ! Fixed volume ! 
    … …  
    220220            DO jk = 1, jpkm1 
    221221               ze3t_f(:,:,jk) = ze3t_f(:,:,jk) - zcoef * zwfld(:,:) * tmask(:,:,jk) & 
    222                               &                        * pe3t(:,:,jk,Kmm) / ( ht(:,:) + 1._wp - ssmask(:,:) )  
     222                              &                        * pe3t(:,:,jk,Kmm) / ( ht(:,:) + 1._wp - ssmask(:,:) ) 
    223223            END DO 
    224224            ! 
    … …  
    257257                  pvv(ji,jj,jk,Kmm) = ( zve3n + rn_atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / ze3v_f(ji,jj,jk) 
    258258               END_3D 
    259                pe3u(:,:,1:jpkm1,Kmm) = ze3u_f(:,:,1:jpkm1)   
     259               pe3u(:,:,1:jpkm1,Kmm) = ze3u_f(:,:,1:jpkm1) 
    260260               pe3v(:,:,1:jpkm1,Kmm) = ze3v_f(:,:,1:jpkm1) 
    261261               ! 
    … …  
    268268         IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN 
    269269            ! Revert filtered "now" velocities to time split estimate 
    270             ! Doing it here also means that asselin filter contribution is removed   
     270            ! Doing it here also means that asselin filter contribution is removed 
    271271            zue(:,:) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 
    272             zve(:,:) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1)     
     272            zve(:,:) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 
    273273            DO jk = 2, jpkm1 
    274274               zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
    275                zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk)     
     275               zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
    276276            END DO 
    277277            DO jk = 1, jpkm1 
    … …  
    325325      IF ( iom_use("utau") ) THEN 
    326326         IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 
    327             ALLOCATE(zutau(jpi,jpj))  
     327            ALLOCATE(zutau(jpi,jpj)) 
    328328            DO_2D( 0, 0, 0, 0 ) 
    329                jk = miku(ji,jj)  
     329               jk = miku(ji,jj) 
    330330               zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * puu(ji,jj,jk,Kaa) 
    331331            END_2D 
    … …  
    353353      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' nxt  - puu(:,:,:,Kaa): ', mask1=umask,   & 
    354354         &                                  tab3d_2=pvv(:,:,:,Kaa), clinfo2=' pvv(:,:,:,Kaa): '       , mask2=vmask ) 
    355       !  
     355      ! 
    356356      IF( ln_dynspg_ts )   DEALLOCATE( zue, zve ) 
    357357      IF( l_trddyn     )   DEALLOCATE( zua, zva ) 

  • NEMO/trunk/src/OCE/DYN/dynspg.F90

    r14064 r14072  
    1111 
    1212   !!---------------------------------------------------------------------- 
    13    !!   dyn_spg     : update the dynamics trend with surface pressure gradient  
     13   !!   dyn_spg     : update the dynamics trend with surface pressure gradient 
    1414   !!   dyn_spg_init: initialization, namelist read, and parameters control 
    1515   !!---------------------------------------------------------------------- 
    … …  
    3939   PUBLIC   dyn_spg_init   ! routine called by opa module 
    4040 
    41    INTEGER ::   nspg = 0   ! type of surface pressure gradient scheme defined from lk_dynspg_...  
     41   INTEGER ::   nspg = 0   ! type of surface pressure gradient scheme defined from lk_dynspg_... 
    4242 
    4343   !                       ! Parameter to control the surface pressure gradient scheme 
    … …  
    5252   !!---------------------------------------------------------------------- 
    5353   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    54    !! $Id$  
     54   !! $Id$ 
    5555   !! Software governed by the CeCILL license (see ./LICENSE) 
    5656   !!---------------------------------------------------------------------- 
    … …  
    6161      !!                  ***  ROUTINE dyn_spg  *** 
    6262      !! 
    63       !! ** Purpose :   compute surface pressure gradient including the  
     63      !! ** Purpose :   compute surface pressure gradient including the 
    6464      !!              atmospheric pressure forcing (ln_apr_dyn=T). 
    6565      !! 
    … …  
    6868      !!              - split-explicit : a time splitting technique is used 
    6969      !! 
    70       !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied  
     70      !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied 
    7171      !!             as the gradient of the inverse barometer ssh: 
    7272      !!                apgu = - 1/rho0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb] 
    … …  
    9090      ! 
    9191      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    92          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )  
     92         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    9393         ztrdu(:,:,:) = puu(:,:,:,Krhs) 
    9494         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
    … …  
    144144               zpgv(ji,jj) = zpgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 
    145145            END_2D 
    146             DEALLOCATE( zpice )          
     146            DEALLOCATE( zpice ) 
    147147         ENDIF 
    148148         ! 
    … …  
    160160         ! 
    161161!!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ???? 
    162          !     
     162         ! 
    163163      ENDIF 
    164164      ! 
    … …  
    167167      CASE ( np_TS  )   ;   CALL dyn_spg_ts ( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa ) ! time-splitting 
    168168      END SELECT 
    169       !                     
     169      ! 
    170170      IF( l_trddyn )   THEN                  ! save the surface pressure gradient trends for further diagnostics 
    171171         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 
    172172         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 
    173173         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt, Kmm ) 
    174          DEALLOCATE( ztrdu , ztrdv )  
     174         DEALLOCATE( ztrdu , ztrdv ) 
    175175      ENDIF 
    176176      !                                      ! print mean trends (used for debugging) 
    … …  
    186186      !!--------------------------------------------------------------------- 
    187187      !!                  ***  ROUTINE dyn_spg_init  *** 
    188       !!                 
    189       !! ** Purpose :   Control the consistency between namelist options for  
     188      !! 
     189      !! ** Purpose :   Control the consistency between namelist options for 
    190190      !!              surface pressure gradient schemes 
    191191      !!---------------------------------------------------------------------- 

  • NEMO/trunk/src/OCE/DYN/dynvor.F90

    r14053 r14072  
    1515   !!            3.2  ! 2009-04  (R. Benshila)  vvl: correction of een scheme 
    1616   !!            3.3  ! 2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase 
    17    !!            3.7  ! 2014-04  (G. Madec)  trend simplification: suppress jpdyn_trd_dat vorticity  
     17   !!            3.7  ! 2014-04  (G. Madec)  trend simplification: suppress jpdyn_trd_dat vorticity 
    1818   !!             -   ! 2014-06  (G. Madec)  suppression of velocity curl from in-core memory 
    1919   !!             -   ! 2016-12  (G. Madec, E. Clementi) add Stokes-Coriolis trends (ln_stcor=T) 
    … …  
    7474   INTEGER, PUBLIC, PARAMETER ::   np_MIX = 5   ! MIX scheme 
    7575 
    76    INTEGER ::   ncor, nrvm, ntot   ! choice of calculated vorticity  
     76   INTEGER ::   ncor, nrvm, ntot   ! choice of calculated vorticity 
    7777   !                               ! associated indices: 
    7878   INTEGER, PUBLIC, PARAMETER ::   np_COR = 1         ! Coriolis (planetary) 
    … …  
    8383 
    8484   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2u_2        ! = di(e2u)/2          used in T-point metric term calculation 
    85    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1v_2        ! = dj(e1v)/2           -        -      -       -  
     85   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1v_2        ! = dj(e1v)/2           -        -      -       - 
    8686   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2v_2e1e2f   ! = di(e2u)/(2*e1e2f)  used in F-point metric term calculation 
    8787   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1v)/(2*e1e2f)   -        -      -       - 
    8888   ! 
    8989   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   e3f_0vor   ! e3f used in EEN, ENE and ENS cases (key_qco only) 
    90     
     90 
    9191   REAL(wp) ::   r1_4  = 0.250_wp         ! =1/4 
    9292   REAL(wp) ::   r1_8  = 0.125_wp         ! =1/8 
    9393   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! 1/12 
    94     
     94 
    9595   !! * Substitutions 
    9696#  include "do_loop_substitute.h90" 
    … …  
    111111      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now vorticity term trend 
    112112      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
    113       !!               and planetary vorticity trends) and send them to trd_dyn  
     113      !!               and planetary vorticity trends) and send them to trd_dyn 
    114114      !!               for futher diagnostics (l_trddyn=T) 
    115115      !!---------------------------------------------------------------------- 
    … …  
    163163                             CALL vor_enT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend 
    164164            IF( ln_stcor .AND. .NOT. ln_vortex_force )  THEN 
    165                              CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend  
     165                             CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
    166166            ELSE IF( ln_stcor .AND. ln_vortex_force )   THEN 
    167167                             CALL vor_enT( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend and vortex force 
    … …  
    218218      !!                  ***  ROUTINE vor_enT  *** 
    219219      !! 
    220       !! ** Purpose :   Compute the now total vorticity trend and add it to  
     220      !! ** Purpose :   Compute the now total vorticity trend and add it to 
    221221      !!      the general trend of the momentum equation. 
    222222      !! 
    223       !! ** Method  :   Trend evaluated using now fields (centered in time)  
     223      !! ** Method  :   Trend evaluated using now fields (centered in time) 
    224224      !!       and t-point evaluation of vorticity (planetary and relative). 
    225225      !!       conserves the horizontal kinetic energy. 
    226       !!         The general trend of momentum is increased due to the vorticity  
     226      !!         The general trend of momentum is increased due to the vorticity 
    227227      !!       term which is given by: 
    228228      !!          voru = 1/bu  mj[ ( mi(mj(bf*rvor))+bt*f_t)/e3t  mj[vn] ] 
    … …  
    260260                  &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    261261            END_2D 
    262             IF( ln_dynvor_msk ) THEN                     ! mask relative vorticity  
     262            IF( ln_dynvor_msk ) THEN                     ! mask relative vorticity 
    263263               DO_2D( 1, 0, 1, 0 ) 
    264264                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    … …  
    314314               ! 
    315315            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)                    & 
    316                &                                * (  zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) )   &  
    317                &                                   + zwt(ji,jj  ) * ( pu(ji,jj  ,jk) + pu(ji-1,jj  ,jk) )   )  
     316               &                                * (  zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) )   & 
     317               &                                   + zwt(ji,jj  ) * ( pu(ji,jj  ,jk) + pu(ji-1,jj  ,jk) )   ) 
    318318         END_2D 
    319319         !                                             ! =============== 
    … …  
    332332      !!                  ***  ROUTINE vor_ene  *** 
    333333      !! 
    334       !! ** Purpose :   Compute the now total vorticity trend and add it to  
     334      !! ** Purpose :   Compute the now total vorticity trend and add it to 
    335335      !!      the general trend of the momentum equation. 
    336336      !! 
    337       !! ** Method  :   Trend evaluated using now fields (centered in time)  
     337      !! ** Method  :   Trend evaluated using now fields (centered in time) 
    338338      !!       and the Sadourny (1975) flux form formulation : conserves the 
    339339      !!       horizontal kinetic energy. 
    340       !!         The general trend of momentum is increased due to the vorticity  
     340      !!         The general trend of momentum is increased due to the vorticity 
    341341      !!       term which is given by: 
    342342      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v pvv(:,:,:,Kmm)) ] 
    … …  
    371371         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    372372         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    373             zwz(:,:) = ff_f(:,:)  
     373            zwz(:,:) = ff_f(:,:) 
    374374         CASE ( np_RVO )                           !* relative vorticity 
    375375            DO_2D( 1, 0, 1, 0 ) 
    … …  
    447447            zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1) 
    448448            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    449             pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )  
     449            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
    450450         END_2D 
    451451         !                                             ! =============== 
    … …  
    497497         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    498498         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    499             zwz(:,:) = ff_f(:,:)  
     499            zwz(:,:) = ff_f(:,:) 
    500500         CASE ( np_RVO )                           !* relative vorticity 
    501501            DO_2D( 1, 0, 1, 0 ) 
    … …  
    586586      !!                ***  ROUTINE vor_een  *** 
    587587      !! 
    588       !! ** Purpose :   Compute the now total vorticity trend and add it to  
     588      !! ** Purpose :   Compute the now total vorticity trend and add it to 
    589589      !!      the general trend of the momentum equation. 
    590590      !! 
    591       !! ** Method  :   Trend evaluated using now fields (centered in time)  
    592       !!      and the Arakawa and Lamb (1980) flux form formulation : conserves  
     591      !! ** Method  :   Trend evaluated using now fields (centered in time) 
     592      !!      and the Arakawa and Lamb (1980) flux form formulation : conserves 
    593593      !!      both the horizontal kinetic energy and the potential enstrophy 
    594594      !!      when horizontal divergence is zero (see the NEMO documentation) 
    … …  
    684684            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    685685               DO_2D( 1, 0, 1, 0 ) 
    686                   zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)  
     686                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
    687687               END_2D 
    688688            ENDIF 
    … …  
    735735      !!                ***  ROUTINE vor_eeT  *** 
    736736      !! 
    737       !! ** Purpose :   Compute the now total vorticity trend and add it to  
     737      !! ** Purpose :   Compute the now total vorticity trend and add it to 
    738738      !!      the general trend of the momentum equation. 
    739739      !! 
    740       !! ** Method  :   Trend evaluated using now fields (centered in time)  
    741       !!      and the Arakawa and Lamb (1980) vector form formulation using  
     740      !! ** Method  :   Trend evaluated using now fields (centered in time) 
     741      !!      and the Arakawa and Lamb (1980) vector form formulation using 
    742742      !!      a modified version of Arakawa and Lamb (1980) scheme (see vor_een). 
    743       !!      The change consists in  
     743      !!      The change consists in 
    744744      !!      Add this trend to the general momentum trend (pu_rhs,pv_rhs). 
    745745      !! 
    … …  
    758758      REAL(wp) ::   zua, zva       ! local scalars 
    759759      REAL(wp) ::   zmsk, z1_e3t   ! local scalars 
    760       REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy  
     760      REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy 
    761761      REAL(wp), DIMENSION(jpi,jpj)       ::   ztnw, ztne, ztsw, ztse 
    762762      REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz   ! 3D workspace, avoid lbc_lnk on jpk that is not defined 
    … …  
    803803            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    804804               DO_2D( 1, 0, 1, 0 ) 
    805                   zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)  
     805                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
    806806               END_2D 
    807807            ENDIF 
    … …  
    916916      ! 
    917917      IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' ) 
    918       !                       
     918      ! 
    919919      IF(lwp) WRITE(numout,*)        ! type of calculated vorticity (set ncor, nrvm, ntot) 
    920920      ncor = np_COR                       ! planetary vorticity 
    … …  
    925925         ntot = np_COR        !     -         - 
    926926      CASE( np_VEC_c2  ) 
    927          IF(lwp) WRITE(numout,*) '   ==>>>   vector form dynamics : total vorticity = Coriolis + relative vorticity'  
     927         IF(lwp) WRITE(numout,*) '   ==>>>   vector form dynamics : total vorticity = Coriolis + relative vorticity' 
    928928         nrvm = np_RVO        ! relative vorticity 
    929          ntot = np_CRV        ! relative + planetary vorticity          
     929         ntot = np_CRV        ! relative + planetary vorticity 
    930930      CASE( np_FLX_c2 , np_FLX_ubs  ) 
    931931         IF(lwp) WRITE(numout,*) '   ==>>>   flux form dynamics : total vorticity = Coriolis + metric term' 
    … …  
    971971                  &  + tmask(ji,jj  ,jk) +tmask(ji+1,jj  ,jk)  ) 
    972972               ! 
    973                IF( zmsk /= 0._wp ) THEN  
     973               IF( zmsk /= 0._wp ) THEN 
    974974                  e3f_0vor(ji,jj,jk) = (   e3t_0(ji  ,jj+1,jk)*tmask(ji  ,jj+1,jk)   & 
    975975                     &                   + e3t_0(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    … …  
    997997         CASE( np_EEN )   ;   WRITE(numout,*) '   ==>>>   energy and enstrophy conserving scheme (EEN)' 
    998998         CASE( np_MIX )   ;   WRITE(numout,*) '   ==>>>   mixed enstrophy/energy conserving scheme (MIX)' 
    999          END SELECT          
     999         END SELECT 
    10001000      ENDIF 
    10011001      ! 

  • NEMO/trunk/src/OCE/DYN/dynzad.F90

    r14007 r14072  
    77   !!   NEMO     0.5  ! 2002-07  (G. Madec) Free form, F90 
    88   !!---------------------------------------------------------------------- 
    9     
     9 
    1010   !!---------------------------------------------------------------------- 
    1111   !!   dyn_zad       : vertical advection momentum trend 
    … …  
    2525   IMPLICIT NONE 
    2626   PRIVATE 
    27     
     27 
    2828   PUBLIC   dyn_zad       ! routine called by dynadv.F90 
    2929 
    … …  
    4141      !!---------------------------------------------------------------------- 
    4242      !!                  ***  ROUTINE dynzad  *** 
    43       !!  
    44       !! ** Purpose :   Compute the now vertical momentum advection trend and  
     43      !! 
     44      !! ** Purpose :   Compute the now vertical momentum advection trend and 
    4545      !!      add it to the general trend of momentum equation. 
    4646      !! 
    … …  
    7373 
    7474      IF( l_trddyn )   THEN           ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends 
    75          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )  
    76          ztrdu(:,:,:) = puu(:,:,:,Krhs)  
    77          ztrdv(:,:,:) = pvv(:,:,:,Krhs)  
     75         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
     76         ztrdu(:,:,:) = puu(:,:,:,Krhs) 
     77         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
    7878      ENDIF 
    79        
     79 
    8080      DO jk = 2, jpkm1                ! Vertical momentum advection at level w and u- and v- vertical 
    8181         DO_2D( 0, 1, 0, 1 )              ! vertical fluxes 
    … …  
    111111         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 
    112112         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt, Kmm ) 
    113          DEALLOCATE( ztrdu, ztrdv )  
     113         DEALLOCATE( ztrdu, ztrdv ) 
    114114      ENDIF 
    115115      !                               ! Control print 

  • NEMO/trunk/src/OCE/IOM/in_out_manager.F90

    r13970 r14072  
    1 MODULE in_out_manager    
     1MODULE in_out_manager 
    22   !!====================================================================== 
    33   !!                       ***  MODULE  in_out_manager  *** 
    … …  
    5353   ! The following four values determine the partitioning of the output fields 
    5454   ! into netcdf4 chunks. They are unrelated to the nn_chunk_sz setting which is 
    55    ! for runtime optimisation. The individual netcdf4 chunks can be optionally  
    56    ! gzipped (recommended) leading to significant reductions in I/O volumes  
     55   ! for runtime optimisation. The individual netcdf4 chunks can be optionally 
     56   ! gzipped (recommended) leading to significant reductions in I/O volumes 
    5757   !                         !!!**  variables only used with iom_nf90 routines and key_netcdf4 ** 
    58    INTEGER ::   nn_nchunks_i   !: number of chunks required in the i-dimension  
    59    INTEGER ::   nn_nchunks_j   !: number of chunks required in the j-dimension  
    60    INTEGER ::   nn_nchunks_k   !: number of chunks required in the k-dimension  
    61    INTEGER ::   nn_nchunks_t   !: number of chunks required in the t-dimension  
     58   INTEGER ::   nn_nchunks_i   !: number of chunks required in the i-dimension 
     59   INTEGER ::   nn_nchunks_j   !: number of chunks required in the j-dimension 
     60   INTEGER ::   nn_nchunks_k   !: number of chunks required in the k-dimension 
     61   INTEGER ::   nn_nchunks_t   !: number of chunks required in the t-dimension 
    6262   LOGICAL ::   ln_nc4zip      !: netcdf4 usage: (T) chunk and compress output using the HDF5 sublayers of netcdf4 
    63    !                           !                 (F) ignore chunking request and use the netcdf4 library  
    64    !                           !                     to produce netcdf3-compatible files  
     63   !                           !                 (F) ignore chunking request and use the netcdf4 library 
     64   !                           !                     to produce netcdf3-compatible files 
    6565#endif 
    6666 
    … …  
    8585   !!---------------------------------------------------------------------- 
    8686   INTEGER ::   nitrst                !: time step at which restart file should be written 
    87    LOGICAL ::   lrst_oce              !: logical to control the oce restart write  
    88    LOGICAL ::   lrst_ice              !: logical to control the ice restart write  
    89    LOGICAL ::   lrst_abl              !: logical to control the abl restart write  
     87   LOGICAL ::   lrst_oce              !: logical to control the oce restart write 
     88   LOGICAL ::   lrst_ice              !: logical to control the ice restart write 
     89   LOGICAL ::   lrst_abl              !: logical to control the abl restart write 
    9090   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 
    9191   INTEGER ::   numrir = 0            !: logical unit for ice   restart (read) 
    … …  
    155155 
    156156   !!---------------------------------------------------------------------- 
    157    !!                          Run control   
     157   !!                          Run control 
    158158   !!---------------------------------------------------------------------- 
    159159   INTEGER       ::   no_print = 0          !: optional argument of fld_fill (if present, suppress some control print) 

  • NEMO/trunk/src/OCE/IOM/iom.F90

    r14068 r14072  
    77   !!            2.0  ! 2006-02  (S. Masson) Adaptation to NEMO 
    88   !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime 
    9    !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case   
     9   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case 
    1010   !!            3.6  ! 2014-15  DIMG format removed 
    1111   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes 
    … …  
    2121   !!---------------------------------------------------------------------- 
    2222   USE dom_oce         ! ocean space and time domain 
    23    USE domutl          !  
     23   USE domutl          ! 
    2424   USE c1d             ! 1D vertical configuration 
    2525   USE flo_oce         ! floats module declarations 
    … …  
    4444   USE trc, ONLY    :  profsed 
    4545#endif 
    46    USE lib_fortran  
     46   USE lib_fortran 
    4747   USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal 
    4848   USE iom_nf90 
    … …  
    5151   IMPLICIT NONE 
    5252   PUBLIC   !   must be public to be able to access iom_def through iom 
    53     
     53 
    5454#if defined key_iomput 
    5555   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.        !: iom_put flag 
    … …  
    9595      MODULE PROCEDURE iom_p0d_dp, iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp 
    9696   END INTERFACE iom_put 
    97    
     97 
    9898   !! * Substitutions 
    9999#  include "do_loop_substitute.h90" 
    … …  
    105105CONTAINS 
    106106 
    107    SUBROUTINE iom_init( cdname, kdid, ld_closedef )  
     107   SUBROUTINE iom_init( cdname, kdid, ld_closedef ) 
    108108      !!---------------------------------------------------------------------- 
    109109      !!                     ***  ROUTINE   *** 
    110110      !! 
    111       !! ** Purpose :    
     111      !! ** Purpose : 
    112112      !! 
    113113      !!---------------------------------------------------------------------- 
    114114      CHARACTER(len=*),           INTENT(in)  :: cdname 
    115       INTEGER         , OPTIONAL, INTENT(in)  :: kdid           
     115      INTEGER         , OPTIONAL, INTENT(in)  :: kdid 
    116116      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_closedef 
    117117#if defined key_iomput 
    … …  
    123123      INTEGER           :: ji 
    124124      LOGICAL           :: llrst_context              ! is context related to restart 
    125       LOGICAL           :: llrstr, llrstw  
     125      LOGICAL           :: llrstr, llrstw 
    126126      INTEGER           :: inum 
    127127      ! 
    … …  
    152152      llrst_context = llrstr .OR. llrstw 
    153153 
    154       ! Calendar type is now defined in xml file  
     154      ! Calendar type is now defined in xml file 
    155155      IF (.NOT.(xios_getvar('ref_year' ,irefyear ))) irefyear  = 1900 
    156156      IF (.NOT.(xios_getvar('ref_month',irefmonth))) irefmonth = 01 
    … …  
    169169      IF(.NOT.llrst_context) CALL set_scalar 
    170170      ! 
    171       IF( cdname == cxios_context ) THEN   
    172          CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. )  
     171      IF( cdname == cxios_context ) THEN 
     172         CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 
    173173         CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. ) 
    174174         CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. ) 
    … …  
    191191      ENDIF 
    192192      ! 
    193       IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN   
     193      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 
    194194         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    195195         ! 
    … …  
    223223 
    224224          ! ABL 
    225          IF( .NOT. ALLOCATED(ght_abl) ) THEN   ! force definition for xml files (xios)  
     225         IF( .NOT. ALLOCATED(ght_abl) ) THEN   ! force definition for xml files (xios) 
    226226            ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) )   ! default allocation needed by iom 
    227227            ght_abl(:) = -1._wp   ;   ghw_abl(:) = -1._wp 
    … …  
    230230         CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) ) 
    231231         CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) ) 
    232            
     232 
    233233         ! Add vertical grid bounds 
    234234         zt_bnds(2,:      ) = gdept_1d(:) 
    … …  
    338338      !! 
    339339      !! ** Purpose :  define filename in XIOS context for reading file, 
    340       !!               enable variables present in a file for reading with XIOS  
     340      !!               enable variables present in a file for reading with XIOS 
    341341      !!               id of the file is assumed to be rrestart. 
    342342      !!--------------------------------------------------------------------- 
    343       INTEGER, INTENT(IN) :: idnum  
    344        
     343      INTEGER, INTENT(IN) :: idnum 
     344 
    345345#if defined key_iomput 
    346346      INTEGER                                    :: ndims, nvars, natts, unlimitedDimId, dimlen, xtype,mdims 
    … …  
    423423               CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname,  & 
    424424                                   domain_ref="grid_N", prec = 8,                & 
    425                                    operation = "instant"                         )  
     425                                   operation = "instant"                         ) 
    426426            ELSEIF(mdims == 1) THEN 
    427427               CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 
    … …  
    433433                                   operation = "instant"                        ) 
    434434            ELSE 
    435                WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions'  
     435               WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions' 
    436436               CALL ctl_stop( 'iom_set_vars_active:', ctmp1 ) 
    437437            ENDIF 
    … …  
    457457      CALL xios_get_handle("file_definition", filegroup_hdl ) 
    458458      CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 
    459       IF(nxioso.eq.1) THEN  
    460          CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,&  
    461                                        mode="write", output_freq=xios_timestep)  
    462          IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode'  
    463       ELSE   
    464          CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,&  
    465                                             mode="write", output_freq=xios_timestep)  
    466          IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode'  
    467       ENDIF  
     459      IF(nxioso.eq.1) THEN 
     460         CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 
     461                                       mode="write", output_freq=xios_timestep) 
     462         IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 
     463      ELSE 
     464         CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 
     465                                            mode="write", output_freq=xios_timestep) 
     466         IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 
     467      ENDIF 
    468468      CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 
    469469#endif 
    … …  
    486486      REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :)    :: rd2 
    487487      REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :)    :: rs2 
    488       REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rd3   
     488      REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rd3 
    489489      REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rs3 
    490490#if defined key_iomput 
    … …  
    509509         CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 
    510510                             domain_ref = "grid_N", prec = 8,             & 
    511                              operation = "instant"                        )  
     511                             operation = "instant"                        ) 
    512512      ELSEIF(PRESENT(rs2)) THEN 
    513513         CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 
    … …  
    540540      !! ** Purpose : Used for grid definition when XIOS is used to read/write 
    541541      !!              restart. Returns axis corresponding to the number of levels 
    542       !!              given as an input variable. Axes are defined in routine  
     542      !!              given as an input variable. Axes are defined in routine 
    543543      !!              iom_set_rst_context 
    544544      !!--------------------------------------------------------------------- 
    … …  
    551551      ELSEIF(idlev == jpl) THEN 
    552552         axis_ref="numcat" 
    553 #endif          
     553#endif 
    554554      ELSE 
    555555         write(str, *) idlev 
    … …  
    562562      !!                   ***  FUNCTION    *** 
    563563      !! 
    564       !! ** Purpose : this function returns first available id to keep information about file  
     564      !! ** Purpose : this function returns first available id to keep information about file 
    565565      !!              sets filename in iom_file structure and sets name 
    566566      !!              of XIOS context depending on cdcomp 
    … …  
    583583   END FUNCTION iom_xios_setid 
    584584 
    585    SUBROUTINE iom_set_rst_context(ld_rstr)  
     585   SUBROUTINE iom_set_rst_context(ld_rstr) 
    586586      !!--------------------------------------------------------------------- 
    587587      !!                   ***  SUBROUTINE  iom_set_rst_context  *** 
    588588      !! 
    589       !! ** Purpose : Define domain, axis and grid for restart (read/write)  
    590       !!              context  
    591       !!                
     589      !! ** Purpose : Define domain, axis and grid for restart (read/write) 
     590      !!              context 
     591      !! 
    592592      !!--------------------------------------------------------------------- 
    593593      LOGICAL, INTENT(IN)               :: ld_rstr 
    594594      INTEGER :: ji 
    595595#if defined key_iomput 
    596       TYPE(xios_domaingroup)            :: domaingroup_hdl  
    597       TYPE(xios_domain)                 :: domain_hdl  
    598       TYPE(xios_axisgroup)              :: axisgroup_hdl  
    599       TYPE(xios_axis)                   :: axis_hdl  
    600       TYPE(xios_scalar)                 :: scalar_hdl  
    601       TYPE(xios_scalargroup)            :: scalargroup_hdl  
    602  
    603       CALL xios_get_handle("domain_definition",domaingroup_hdl)  
    604       CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N")  
    605       CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr)  
    606   
    607       CALL xios_get_handle("axis_definition",axisgroup_hdl)  
    608       CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev")  
     596      TYPE(xios_domaingroup)            :: domaingroup_hdl 
     597      TYPE(xios_domain)                 :: domain_hdl 
     598      TYPE(xios_axisgroup)              :: axisgroup_hdl 
     599      TYPE(xios_axis)                   :: axis_hdl 
     600      TYPE(xios_scalar)                 :: scalar_hdl 
     601      TYPE(xios_scalargroup)            :: scalargroup_hdl 
     602 
     603      CALL xios_get_handle("domain_definition",domaingroup_hdl) 
     604      CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 
     605      CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr) 
     606 
     607      CALL xios_get_handle("axis_definition",axisgroup_hdl) 
     608      CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 
    609609!AGRIF fails to compile when unit= is in call to xios_set_axis_attr 
    610 !     CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels",  unit="m", positive="down")  
     610!     CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels",  unit="m", positive="down") 
    611611      CALL xios_set_axis_attr( "nav_lev", long_name = "Vertical levels in meters", positive = "down") 
    612       CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d )  
     612      CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 
    613613#if defined key_si3 
    614614      CALL xios_add_child(axisgroup_hdl, axis_hdl, "numcat") 
    615615      CALL iom_set_axis_attr( "numcat", (/ (REAL(ji,wp), ji=1,jpl) /) ) 
    616616#endif 
    617       CALL xios_get_handle("scalar_definition", scalargroup_hdl)  
    618       CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar")  
     617      CALL xios_get_handle("scalar_definition", scalargroup_hdl) 
     618      CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 
    619619#endif 
    620620   END SUBROUTINE iom_set_rst_context 
    621621 
    622622 
    623    SUBROUTINE set_xios_context(kdid, cdcont)  
     623   SUBROUTINE set_xios_context(kdid, cdcont) 
    624624      !!--------------------------------------------------------------------- 
    625625      !!                   ***  SUBROUTINE  iom_set_rst_context  *** 
    626626      !! 
    627627      !! ** Purpose : set correct XIOS context based on kdid 
    628       !!                
     628      !! 
    629629      !!--------------------------------------------------------------------- 
    630630      INTEGER,           INTENT(IN)     :: kdid           ! Identifier of the file 
    631631      CHARACTER(LEN=lc), INTENT(OUT)    :: cdcont         ! name of the context for XIOS read/write 
    632        
     632 
    633633      cdcont = "NONE" 
    634634 
    … …  
    637637            cdcont = cr_ocerst_cxt 
    638638         ELSEIF(kdid == numrir) THEN 
    639             cdcont = cr_icerst_cxt  
     639            cdcont = cr_icerst_cxt 
    640640         ELSEIF(kdid == numrtr) THEN 
    641641            cdcont = cr_toprst_cxt 
    … …  
    696696      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
    697697      CHARACTER(LEN=256)    ::   cltmpn    ! tempory name to store clname (in writting mode) 
    698       CHARACTER(LEN=10)     ::   clsuffix  ! ".nc"  
     698      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" 
    699699      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits) 
    700700      CHARACTER(LEN=256)    ::   clinfo    ! info character 
    701       LOGICAL               ::   llok      ! check the existence  
     701      LOGICAL               ::   llok      ! check the existence 
    702702      LOGICAL               ::   llwrt     ! local definition of ldwrt 
    703703      LOGICAL               ::   llstop    ! local definition of ldstop 
    … …  
    705705      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits) 
    706706      INTEGER               ::   iln, ils  ! lengths of character 
    707       INTEGER               ::   istop     !  
     707      INTEGER               ::   istop     ! 
    708708      ! local number of points for x,y dimensions 
    709709      ! position of first local point for x,y dimensions 
    … …  
    741741      clname   = trim(cdname) 
    742742      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 
    743          iln    = INDEX(clname,'/')  
     743         iln    = INDEX(clname,'/') 
    744744         cltmpn = clname(1:iln) 
    745745         clname = clname(iln+1:LEN_TRIM(clname)) 
    … …  
    765765         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix) 
    766766         icnt = 0 
    767          INQUIRE( FILE = clname, EXIST = llok )  
     767         INQUIRE( FILE = clname, EXIST = llok ) 
    768768         ! we try different formats for the cpu number by adding 0 
    769769         DO WHILE( .NOT.llok .AND. icnt < jpmax_digits ) 
    … …  
    783783      ! if no file was found... 
    784784      IF( .NOT. llok ) THEN 
    785          IF( .NOT. llwrt ) THEN   ! we are in read mode  
     785         IF( .NOT. llwrt ) THEN   ! we are in read mode 
    786786            IF( llstop ) THEN   ;   CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' ) 
    787787            ELSE                ;   istop = nstop + 1   ! make sure that istop /= nstop so we don't open the file 
    788788            ENDIF 
    789          ELSE                     ! we are in write mode so we  
     789         ELSE                     ! we are in write mode so we 
    790790            clname = cltmpn       ! get back the file name without the cpu number 
    791791         ENDIF 
    792792      ELSE 
    793          IF( llwrt .AND. .NOT. ln_clobber ) THEN   ! we stop as we want to write in a new file  
     793         IF( llwrt .AND. .NOT. ln_clobber ) THEN   ! we stop as we want to write in a new file 
    794794            CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' ) 
    795795            istop = nstop + 1                      ! make sure that istop /= nstop so we don't open the file 
    796          ELSEIF( llwrt ) THEN     ! the file exists and we are in write mode with permission to  
     796         ELSEIF( llwrt ) THEN     ! the file exists and we are in write mode with permission to 
    797797            clname = cltmpn       ! overwrite so get back the file name without the cpu number 
    798798         ENDIF 
    … …  
    835835            IF( iom_file(jf)%nfid > 0 ) THEN 
    836836               CALL iom_nf90_close( jf ) 
    837                iom_file(jf)%nfid       = 0          ! free the id  
     837               iom_file(jf)%nfid       = 0          ! free the id 
    838838               IF( PRESENT(kiomid) )   kiomid = 0   ! return 0 as id to specify that the file was closed 
    839839               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok' 
    … …  
    844844         END DO 
    845845      ENDIF 
    846       !     
     846      ! 
    847847   END SUBROUTINE iom_close 
    848848 
    849849 
    850    FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop )   
     850   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop ) 
    851851      !!----------------------------------------------------------------------- 
    852852      !!                  ***  FUNCTION  iom_varid  *** 
    … …  
    874874      IF( kiomid > 0 ) THEN 
    875875         clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar) 
    876          IF( iom_file(kiomid)%nfid == 0 ) THEN  
     876         IF( iom_file(kiomid)%nfid == 0 ) THEN 
    877877            CALL ctl_stop( trim(clinfo), 'the file is not open' ) 
    878878         ELSE 
    … …  
    893893                        &                      'increase the parameter jpmax_vars') 
    894894               ENDIF 
    895                IF( llstop .AND. iom_varid == -1 )   CALL ctl_stop( TRIM(clinfo)//' not found' )  
     895               IF( llstop .AND. iom_varid == -1 )   CALL ctl_stop( TRIM(clinfo)//' not found' ) 
    896896            ELSE 
    897897               iom_varid = iiv 
    898                IF( PRESENT(kdimsz) ) THEN  
     898               IF( PRESENT(kdimsz) ) THEN 
    899899                  i_nvd = iom_file(kiomid)%ndims(iiv) 
    900900                  IF( i_nvd <= size(kdimsz) ) THEN 
    … …  
    10221022      REAL(dp)        , ALLOCATABLE  , DIMENSION(:)           ::   ztmp_pvar ! tmp var to read field 
    10231023      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
    1024       INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading  
     1024      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading 
    10251025      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis 
    10261026      ! 
    … …  
    10431043      REAL(dp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field 
    10441044      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
    1045       INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading  
     1045      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading 
    10461046      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis 
    10471047      ! 
    … …  
    10621062      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
    10631063      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    1064       INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading  
     1064      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading 
    10651065      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kcount    ! number of points in each axis 
    10661066      ! 
    … …  
    10861086      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
    10871087      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    1088       INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading  
     1088      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading 
    10891089      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kcount    ! number of points in each axis 
    10901090      ! 
    … …  
    11061106      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
    11071107      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    1108       INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading  
     1108      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading 
    11091109      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kcount    ! number of points in each axis 
    11101110      ! 
    … …  
    11301130      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
    11311131      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    1132       INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading  
     1132      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading 
    11331133      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kcount    ! number of points in each axis 
    11341134      ! 
    … …  
    11631163      REAL(dp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
    11641164      INTEGER                    , INTENT(in   ), OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    1165       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart    ! start position of the reading in each axis  
     1165      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart    ! start position of the reading in each axis 
    11661166      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount    ! number of points to be read in each axis 
    11671167      ! 
    11681168      LOGICAL                        ::   llok        ! true if ok! 
    1169       INTEGER                        ::   jl          ! loop on number of dimension  
     1169      INTEGER                        ::   jl          ! loop on number of dimension 
    11701170      INTEGER                        ::   idom        ! type of domain 
    11711171      INTEGER                        ::   idvar       ! id of the variable 
    11721172      INTEGER                        ::   inbdim      ! number of dimensions of the variable 
    1173       INTEGER                        ::   idmspc      ! number of spatial dimensions  
     1173      INTEGER                        ::   idmspc      ! number of spatial dimensions 
    11741174      INTEGER                        ::   itime       ! record number 
    11751175      INTEGER                        ::   istop       ! temporary value of nstop 
    11761176      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes 
    11771177      INTEGER                        ::   ji, jj      ! loop counters 
    1178       INTEGER                        ::   irankpv     !  
     1178      INTEGER                        ::   irankpv     ! 
    11791179      INTEGER                        ::   ind1, ind2  ! substring index 
    11801180      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis 
    1181       INTEGER, DIMENSION(jpmax_dims) ::   icnt        ! number of value to read along each axis  
     1181      INTEGER, DIMENSION(jpmax_dims) ::   icnt        ! number of value to read along each axis 
    11821182      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable 
    11831183      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable 
    … …  
    11871187      CHARACTER(LEN=256)             ::   clinfo      ! info character 
    11881188      CHARACTER(LEN=256)             ::   clname      ! file name 
    1189       CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !  
     1189      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      ! 
    11901190      CHARACTER(LEN=1)               ::   cl_type     ! local value of cd_type 
    11911191      LOGICAL                        ::   ll_only3rd  ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
    … …  
    12151215         ! Search for the variable in the data base (eventually actualize data) 
    12161216         ! 
    1217          idvar = iom_varid( kiomid, cdvar )  
     1217         idvar = iom_varid( kiomid, cdvar ) 
    12181218         IF( idvar > 0 ) THEN 
    12191219            ! 
    … …  
    12221222            idmspc = inbdim                                   ! number of spatial dimensions in the file 
    12231223            IF( iom_file(kiomid)%luld(idvar) )   idmspc = inbdim - 1 
    1224             IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...')  
     1224            IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 
    12251225            ! 
    12261226            ! Identify the domain in case of jpdom_auto definition 
    1227             IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN             
     1227            IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN 
    12281228               idom = jpdom_global   ! default 
    12291229               ! else: if the file name finishes with _xxxx.nc with xxxx any number 
    … …  
    12621262                     CALL ctl_warn( trim(clinfo), '2D array input but 3 spatial dimensions in the file...'              ,   & 
    12631263                           &         'As the size of the z dimension is 1 and as we try to read the first record, ',   & 
    1264                            &         'we accept this case, even if there is a possible mix-up between z and time dimension' )    
     1264                           &         'we accept this case, even if there is a possible mix-up between z and time dimension' ) 
    12651265                     idmspc = idmspc - 1 
    12661266                  !!GS: possibility to read 3D ABL atmopsheric forcing and use 1st level to force BULK simulation 
    … …  
    12741274            ! definition of istart and icnt 
    12751275            ! 
    1276             icnt  (:) = 1              ! default definition (simple way to deal with special cases listed above)  
    1277             istart(:) = 1              ! default definition (simple way to deal with special cases listed above)  
     1276            icnt  (:) = 1              ! default definition (simple way to deal with special cases listed above) 
     1277            istart(:) = 1              ! default definition (simple way to deal with special cases listed above) 
    12781278            istart(idmspc+1) = itime   ! temporal dimenstion 
    12791279            ! 
    12801280            IF( idom == jpdom_unknown ) THEN 
    1281                IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN  
    1282                   istart(1:idmspc) = kstart(1:idmspc)  
     1281               IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN 
     1282                  istart(1:idmspc) = kstart(1:idmspc) 
    12831283                  icnt  (1:idmspc) = kcount(1:idmspc) 
    12841284               ELSE 
    … …  
    12861286               ENDIF 
    12871287            ELSE   !   not a 1D array as pv_r1d requires jpdom_unknown 
    1288                ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0  
     1288               ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0 
    12891289               IF( idom == jpdom_global )   istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /) 
    12901290               icnt(1:2) = (/ Ni_0, Nj_0 /) 
    … …  
    13061306                  WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 
    13071307                  WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)"         ) jl, idimsz(jl) 
    1308                   CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )      
     1308                  CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 
    13091309               ENDIF 
    13101310            END DO 
    13111311            ! 
    13121312            ! check that icnt matches the input array 
    1313             !-      
     1313            !- 
    13141314            IF( idom == jpdom_unknown ) THEN 
    13151315               IF( irankpv == 1 )        ishape(1:1) = SHAPE(pv_r1d) 
    … …  
    13211321                  ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0  ))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)' 
    13221322               ENDIF 
    1323                IF( irankpv == 3 ) THEN  
     1323               IF( irankpv == 3 ) THEN 
    13241324                  ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)' 
    13251325               ENDIF 
    1326             ENDIF          
     1326            ENDIF 
    13271327            DO jl = 1, irankpv 
    13281328               WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 
    … …  
    13331333 
    13341334         ! read the data 
    1335          !-      
     1335         !- 
    13361336         IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point... 
    13371337            ! 
    … …  
    13401340            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    13411341            ENDIF 
    1342        
     1342 
    13431343            CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d, pv_r3d ) 
    13441344 
    … …  
    13941394         CALL iom_swap(cxios_context) 
    13951395#else 
    1396          istop = istop + 1  
     1396         istop = istop + 1 
    13971397         clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar) 
    13981398#endif 
    … …  
    14071407      zofs = iom_file(kiomid)%ofs(idvar)      ! offset 
    14081408      IF(     PRESENT(pv_r1d) ) THEN 
    1409          IF( zscf /= 1._wp )   pv_r1d(:) = pv_r1d(:) * zscf  
     1409         IF( zscf /= 1._wp )   pv_r1d(:) = pv_r1d(:) * zscf 
    14101410         IF( zofs /= 0._wp )   pv_r1d(:) = pv_r1d(:) + zofs 
    14111411      ELSEIF( PRESENT(pv_r2d) ) THEN 
    … …  
    14211421   SUBROUTINE iom_get_var( cdname, z2d) 
    14221422      CHARACTER(LEN=*), INTENT(in ) ::   cdname 
    1423       REAL(wp), DIMENSION(jpi,jpj) ::   z2d  
     1423      REAL(wp), DIMENSION(jpi,jpj) ::   z2d 
    14241424#if defined key_iomput 
    14251425      IF( xios_field_is_active( cdname, at_current_timestep_arg = .TRUE. ) ) THEN 
    … …  
    14331433 
    14341434 
    1435    FUNCTION iom_getszuld ( kiomid )   
     1435   FUNCTION iom_getszuld ( kiomid ) 
    14361436      !!----------------------------------------------------------------------- 
    14371437      !!                  ***  FUNCTION  iom_getszuld  *** 
    … …  
    14491449      ENDIF 
    14501450   END FUNCTION iom_getszuld 
    1451     
     1451 
    14521452 
    14531453   !!---------------------------------------------------------------------- 
    … …  
    15131513      ENDIF 
    15141514   END SUBROUTINE iom_g1d_ratt 
    1515     
     1515 
    15161516   SUBROUTINE iom_g0d_catt( kiomid, cdatt, cdatt0d, cdvar ) 
    15171517      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file 
    … …  
    15721572      ENDIF 
    15731573   END SUBROUTINE iom_p1d_ratt 
    1574     
     1574 
    15751575   SUBROUTINE iom_p0d_catt( kiomid, cdatt, cdatt0d, cdvar ) 
    15761576      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file 
    … …  
    15911591      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    15921592      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    1593       INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1593      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
    15941594      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    15951595      REAL(sp)        , INTENT(in)                         ::   pvar     ! written field 
    … …  
    16141614            IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 
    16151615            CALL iom_swap(context) 
    1616             CALL iom_set_rstw_active( trim(cdvar), rs0 = pvar )  
     1616            CALL iom_set_rstw_active( trim(cdvar), rs0 = pvar ) 
    16171617            CALL iom_swap(cxios_context) 
    16181618         ENDIF 
    … …  
    16311631      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    16321632      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    1633       INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1633      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
    16341634      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    16351635      REAL(dp)        , INTENT(in)                         ::   pvar     ! written field 
    … …  
    16541654            IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 
    16551655            CALL iom_swap(context) 
    1656             CALL iom_set_rstw_active( trim(cdvar), rd0 = pvar )  
     1656            CALL iom_set_rstw_active( trim(cdvar), rd0 = pvar ) 
    16571657            CALL iom_swap(cxios_context) 
    16581658         ENDIF 
    … …  
    16721672      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    16731673      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    1674       INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1674      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
    16751675      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    16761676      REAL(sp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
    … …  
    17121712      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    17131713      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    1714       INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1714      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
    17151715      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    17161716      REAL(dp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
    … …  
    17531753      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    17541754      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    1755       INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1755      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
    17561756      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    17571757      REAL(sp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
    … …  
    17931793      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    17941794      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    1795       INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1795      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
    17961796      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    17971797      REAL(dp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
    … …  
    18341834      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    18351835      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    1836       INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1836      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
    18371837      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    18381838      REAL(sp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
    … …  
    18741874      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    18751875      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    1876       INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1876      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
    18771877      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    18781878      REAL(dp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
    … …  
    19541954         ! 
    19551955      ENDIF 
    1956        
     1956 
    19571957   END SUBROUTINE iom_delay_rst 
    1958    
    1959     
     1958 
     1959 
    19601960 
    19611961   !!---------------------------------------------------------------------- 
    … …  
    19691969!!clem      zz(:,:)=pfield0d 
    19701970!!clem      CALL xios_send_field(cdname, zz) 
    1971       CALL xios_send_field(cdname, (/pfield0d/))  
     1971      CALL xios_send_field(cdname, (/pfield0d/)) 
    19721972#else 
    19731973      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    … …  
    19821982!!clem      zz(:,:)=pfield0d 
    19831983!!clem      CALL xios_send_field(cdname, zz) 
    1984       CALL xios_send_field(cdname, (/pfield0d/))  
     1984      CALL xios_send_field(cdname, (/pfield0d/)) 
    19851985#else 
    19861986      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    … …  
    21262126      TYPE(xios_gridgroup) :: gridgroup_hdl 
    21272127      TYPE(xios_grid)      :: grid_hdl 
    2128       TYPE(xios_domain)    :: domain_hdl  
    2129       TYPE(xios_axis)      :: axis_hdl  
     2128      TYPE(xios_domain)    :: domain_hdl 
     2129      TYPE(xios_axis)      :: axis_hdl 
    21302130      CHARACTER(LEN=64)    :: cldomrefid   ! domain_ref name 
    21312131      CHARACTER(len=1)     :: cl1          ! last character of this name 
    … …  
    21472147         CALL xios_add_child(grid_hdl, axis_hdl, 'depth'//cl1)              ! add its axis 
    21482148      ENDIF 
    2149       !       
     2149      ! 
    21502150   END SUBROUTINE iom_set_zoom_domain_attr 
    21512151 
    … …  
    22402240      !!---------------------------------------------------------------------- 
    22412241      !!---------------------------------------------------------------------- 
    2242       INTEGER         , INTENT(in) ::   kt  
     2242      INTEGER         , INTENT(in) ::   kt 
    22432243      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    22442244      !!---------------------------------------------------------------------- 
    … …  
    22552255      !!---------------------------------------------------------------------- 
    22562256      clname = cdname 
    2257       IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname  
     2257      IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname 
    22582258      IF( xios_is_valid_context(clname) ) THEN 
    22592259         CALL iom_swap( cdname )   ! swap to cdname context 
    … …  
    22812281      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0) 
    22822282      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni=jpi, data_jbegin = -nn_hls, data_nj=jpj) 
    2283 !don't define lon and lat for restart reading context.  
     2283!don't define lon and lat for restart reading context. 
    22842284      IF ( .NOT.ldrxios ) & 
    22852285         CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp),   & 
    2286          &                                        latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp ))   
     2286         &                                        latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp )) 
    22872287      ! 
    22882288      IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN 
    … …  
    23842384      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = -nn_hls, data_ni = jpi, data_jbegin = -nn_hls, data_nj = jpj) 
    23852385      CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp),   & 
    2386          &                             latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp))   
     2386         &                             latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp)) 
    23872387      CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj0glo) 
    23882388      ! 
    … …  
    24332433      TYPE(xios_duration)            ::   f_op, f_of 
    24342434      !!---------------------------------------------------------------------- 
    2435       !  
     2435      ! 
    24362436      ! frequency of the call of iom_put (attribut: freq_op) 
    24372437      f_op%timestep = 1        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 
    … …  
    24442444      ! output file names (attribut: name) 
    24452445      DO ji = 1, 9 
    2446          WRITE(cl1,'(i1)') ji  
     2446         WRITE(cl1,'(i1)') ji 
    24472447         CALL iom_update_file_name('file'//cl1) 
    24482448      END DO 
    24492449      DO ji = 1, 99 
    2450          WRITE(cl2,'(i2.2)') ji  
     2450         WRITE(cl2,'(i2.2)') ji 
    24512451         CALL iom_update_file_name('file'//cl2) 
    24522452      END DO 
    24532453      DO ji = 1, 999 
    2454          WRITE(cl3,'(i3.3)') ji  
     2454         WRITE(cl3,'(i3.3)') ji 
    24552455         CALL iom_update_file_name('file'//cl3) 
    24562456      END DO 
    24572457 
    24582458      ! Zooms... 
    2459       clgrd = (/ 'T', 'U', 'W' /)  
     2459      clgrd = (/ 'T', 'U', 'W' /) 
    24602460      DO jg = 1, SIZE(clgrd)                                                                   ! grid type 
    24612461         cl1 = clgrd(jg) 
    … …  
    25222522               IF( zlon == -10. .AND. zlat ==   4. ) THEN   ;   zlon = 0.   ;   zlat = 0.   ;   ENDIF 
    25232523               CALL dom_ngb( zlon, zlat, ix, iy, cl1 ) 
    2524                IF( zlon >= 0. ) THEN   
     2524               IF( zlon >= 0. ) THEN 
    25252525                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT( zlon), 'e' 
    25262526                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')       zlon , 'e' 
    25272527                  ENDIF 
    2528                ELSE              
     2528               ELSE 
    25292529                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT(-zlon), 'w' 
    25302530                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')      -zlon , 'w' 
    25312531                  ENDIF 
    25322532               ENDIF 
    2533                IF( zlat >= 0. ) THEN   
     2533               IF( zlat >= 0. ) THEN 
    25342534                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT( zlat), 'n' 
    25352535                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')       zlat , 'n' 
    25362536                  ENDIF 
    2537                ELSE              
     2537               ELSE 
    25382538                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT(-zlat), 's' 
    25392539                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')      -zlat , 's' 
    … …  
    25492549         END DO 
    25502550      END DO 
    2551        
     2551 
    25522552   END SUBROUTINE set_mooring 
    25532553 
    2554     
     2554 
    25552555   SUBROUTINE iom_update_file_name( cdid ) 
    25562556      !!---------------------------------------------------------------------- 
    25572557      !!                     ***  ROUTINE iom_update_file_name  *** 
    25582558      !! 
    2559       !! ** Purpose :    
     2559      !! ** Purpose : 
    25602560      !! 
    25612561      !!---------------------------------------------------------------------- 
    … …  
    25712571      REAL(wp)           ::   zsec 
    25722572      LOGICAL            ::   llexist 
    2573       TYPE(xios_duration)   ::   output_freq  
     2573      TYPE(xios_duration)   ::   output_freq 
    25742574      !!---------------------------------------------------------------------- 
    25752575      ! 
    … …  
    25802580         IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname ) 
    25812581         ! 
    2582          IF ( TRIM(clname) /= '' ) THEN  
     2582         IF ( TRIM(clname) /= '' ) THEN 
    25832583            ! 
    25842584            idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 
    2585             DO WHILE ( idx /= 0 )  
     2585            DO WHILE ( idx /= 0 ) 
    25862586               clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname)) 
    25872587               idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 
    … …  
    25892589            ! 
    25902590            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    2591             DO WHILE ( idx /= 0 )  
     2591            DO WHILE ( idx /= 0 ) 
    25922592              IF ( output_freq%timestep /= 0) THEN 
    2593                   WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts'  
     2593                  WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts' 
    25942594                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
    25952595              ELSE IF ( output_freq%second /= 0 ) THEN 
    2596                   WRITE(clfreq,'(I19,A1)')INT(output_freq%second),'s'  
     2596                  WRITE(clfreq,'(I19,A1)')INT(output_freq%second),'s' 
    25972597                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
    25982598              ELSE IF ( output_freq%minute /= 0 ) THEN 
    2599                   WRITE(clfreq,'(I18,A2)')INT(output_freq%minute),'mi'  
     2599                  WRITE(clfreq,'(I18,A2)')INT(output_freq%minute),'mi' 
    26002600                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
    26012601              ELSE IF ( output_freq%hour /= 0 ) THEN 
    2602                   WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h'  
     2602                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 
    26032603                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
    26042604              ELSE IF ( output_freq%day /= 0 ) THEN 
    2605                   WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d'  
     2605                  WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 
    26062606                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
    2607               ELSE IF ( output_freq%month /= 0 ) THEN    
    2608                   WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m'  
     2607              ELSE IF ( output_freq%month /= 0 ) THEN 
     2608                  WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 
    26092609                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
    2610               ELSE IF ( output_freq%year /= 0 ) THEN    
    2611                   WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y'  
     2610              ELSE IF ( output_freq%year /= 0 ) THEN 
     2611                  WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 
    26122612                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
    26132613              ELSE 
    … …  
    26202620            ! 
    26212621            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    2622             DO WHILE ( idx /= 0 )  
     2622            DO WHILE ( idx /= 0 ) 
    26232623               cldate = iom_sdate( fjulday - rn_Dt / rday ) 
    26242624               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 
    … …  
    26272627            ! 
    26282628            idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 
    2629             DO WHILE ( idx /= 0 )  
     2629            DO WHILE ( idx /= 0 ) 
    26302630               cldate = iom_sdate( fjulday - rn_Dt / rday, ldfull = .TRUE. ) 
    26312631               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 
    … …  
    26342634            ! 
    26352635            idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 
    2636             DO WHILE ( idx /= 0 )  
     2636            DO WHILE ( idx /= 0 ) 
    26372637               cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 
    26382638               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 
    … …  
    26412641            ! 
    26422642            idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 
    2643             DO WHILE ( idx /= 0 )  
     2643            DO WHILE ( idx /= 0 ) 
    26442644               cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 
    26452645               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 
    … …  
    26692669      ! 
    26702670      CHARACTER(LEN=20) ::   iom_sdate 
    2671       CHARACTER(LEN=50) ::   clfmt                         !  format used to write the date  
     2671      CHARACTER(LEN=50) ::   clfmt                         !  format used to write the date 
    26722672      INTEGER           ::   iyear, imonth, iday, ihour, iminute, isec 
    26732673      REAL(wp)          ::   zsec 
    … …  
    26912691      ENDIF 
    26922692      ! 
    2693       IF( iyear < 10000 ) THEN   ;   clfmt = "i4.4,2i2.2"                ! format used to write the date  
     2693      IF( iyear < 10000 ) THEN   ;   clfmt = "i4.4,2i2.2"                ! format used to write the date 
    26942694      ELSE                       ;   WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1 
    26952695      ENDIF 
    26962696      ! 
    2697 !$AGRIF_DO_NOT_TREAT       
     2697!$AGRIF_DO_NOT_TREAT 
    26982698      ! needed in the conv 
    2699       IF( llfull ) THEN  
     2699      IF( llfull ) THEN 
    27002700         clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" 
    27012701         ihour   = isec / 3600 
    … …  
    27072707         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run 
    27082708      ENDIF 
    2709 !$AGRIF_END_DO_NOT_TREAT       
     2709!$AGRIF_END_DO_NOT_TREAT 
    27102710      ! 
    27112711   END FUNCTION iom_sdate 
    … …  
    27162716   !!---------------------------------------------------------------------- 
    27172717   SUBROUTINE iom_setkt( kt, cdname ) 
    2718       INTEGER         , INTENT(in)::   kt  
     2718      INTEGER         , INTENT(in)::   kt 
    27192719      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    27202720      IF( .FALSE. )   WRITE(numout,*) kt, cdname   ! useless test to avoid compilation warnings 
    … …  
    27442744   SUBROUTINE iom_miss_val( cdname, pmiss_val ) 
    27452745      CHARACTER(LEN=*), INTENT(in ) ::   cdname 
    2746       REAL(wp)        , INTENT(out) ::   pmiss_val    
    2747       REAL(dp)                      ::   ztmp_pmiss_val    
     2746      REAL(wp)        , INTENT(out) ::   pmiss_val 
     2747      REAL(dp)                      ::   ztmp_pmiss_val 
    27482748#if defined key_iomput 
    27492749      ! get missing value 
    … …  
    27552755#endif 
    27562756   END SUBROUTINE iom_miss_val 
    2757    
     2757 
    27582758   !!====================================================================== 
    27592759END MODULE iom 

  • NEMO/trunk/src/OCE/IOM/iom_def.F90

    r13970 r14072  
    1717   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 2   !: (Nis0: Nie0 ,Njs0: Nje0 ) 
    1818   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 3   !: No dimension checking 
    19    INTEGER, PARAMETER, PUBLIC ::   jpdom_auto          = 4   !:  
     19   INTEGER, PARAMETER, PUBLIC ::   jpdom_auto          = 4   !: 
    2020   INTEGER, PARAMETER, PUBLIC ::   jpdom_auto_xy       = 5   !: Automatically set horizontal dimensions only 
    2121 
    … …  
    3333!$AGRIF_DO_NOT_TREAT 
    3434   INTEGER, PUBLIC            ::   iom_open_init = 0   !: used to initialize iom_file(:)%nfid to 0 
    35 !XIOS write restart    
     35!XIOS write restart 
    3636   LOGICAL, PUBLIC            ::   lwxios = .FALSE.    !: write single file restart using XIOS 
    3737   INTEGER, PUBLIC            ::   nxioso = 0          !: type of restart file when writing using XIOS 1 - single, 2 - multiple 
    38 !XIOS read restart    
     38!XIOS read restart 
    3939   LOGICAL, PUBLIC            ::   lrxios = .FALSE.     !: read single file restart using XIOS main switch 
    4040   LOGICAL, PUBLIC            ::   lxios_sini = .FALSE. ! is restart in a single file 
    … …  
    5050      INTEGER                                   ::   iduld    !: id of the unlimited dimension 
    5151      INTEGER                                   ::   lenuld   !: length of the unlimited dimension (number of records in file) 
    52       INTEGER                                   ::   irec     !: writing record position   
     52      INTEGER                                   ::   irec     !: writing record position 
    5353      CHARACTER(LEN=32)                         ::   uldname  !: name of the unlimited dimension 
    5454      CHARACTER(LEN=32), DIMENSION(jpmax_vars)  ::   cn_var   !: names of the variables 
    … …  
    5656      INTEGER, DIMENSION(jpmax_vars)            ::   ndims    !: number of dimensions of the variables 
    5757      LOGICAL, DIMENSION(jpmax_vars)            ::   luld     !: variable using the unlimited dimension 
    58       INTEGER, DIMENSION(jpmax_dims,jpmax_vars) ::   dimsz    !: size of variables dimensions  
     58      INTEGER, DIMENSION(jpmax_dims,jpmax_vars) ::   dimsz    !: size of variables dimensions 
    5959      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables 
    6060      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables 

  • NEMO/trunk/src/OCE/IOM/iom_nf90.F90

    r13970 r14072  
    3434 
    3535   INTERFACE iom_nf90_get 
    36       MODULE PROCEDURE iom_nf90_g0d_sp                    
     36      MODULE PROCEDURE iom_nf90_g0d_sp 
    3737      MODULE PROCEDURE iom_nf90_g0d_dp, iom_nf90_g123d_dp 
    3838   END INTERFACE 
    … …  
    5757      INTEGER                , INTENT(  out)           ::   kiomid      ! nf90 identifier of the opened file 
    5858      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file? 
    59       LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence  
     59      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
    6060      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension 
    6161      CHARACTER(len=3)       , INTENT(in   ), OPTIONAL ::   cdcomp      ! name of component calling iom_nf90_open 
    … …  
    8585         clcomp = cdcomp    ! use input value 
    8686      ELSE 
    87          clcomp = 'OCE'     ! by default  
     87         clcomp = 'OCE'     ! by default 
    8888      ENDIF 
    8989      ! 
    … …  
    120120 
    121121            IF( llclobber ) THEN   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_CLOBBER   ) 
    122             ELSE                   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER )  
     122            ELSE                   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 
    123123            ENDIF 
    124124            IF( snc4set%luse ) THEN 
    … …  
    172172         iom_file(kiomid)%nfid   = if90id 
    173173         iom_file(kiomid)%nvars  = 0 
    174          iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode  
     174         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode 
    175175         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 
    176176         IF( iom_file(kiomid)%iduld .GE. 0 ) THEN 
    177             CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,    &  
     177            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,    & 
    178178               &                                       name = iom_file(kiomid)%uldname,   & 
    179179               &                                       len  = iom_file(kiomid)%lenuld ), clinfo ) 
    … …  
    201201 
    202202 
    203    FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims, lduld )   
     203   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims, lduld ) 
    204204      !!----------------------------------------------------------------------- 
    205205      !!                  ***  FUNCTION  iom_varid  *** 
    … …  
    209209      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier 
    210210      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable 
    211       INTEGER              , INTENT(in   )           ::   kiv   !  
     211      INTEGER              , INTENT(in   )           ::   kiv   ! 
    212212      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension 
    213213      INTEGER              , INTENT(  out), OPTIONAL ::   kndims   ! number of dimensions 
    … …  
    240240         iom_file(kiomid)%dimsz(:,kiv) = 0      ! reset dimsz in case previously used 
    241241         DO ji = 1, i_nvd                       ! dimensions size 
    242             CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)    
    243             IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension?  
     242            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo) 
     243            IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension? 
    244244         END DO 
    245245         !---------- Deal with scale_factor and add_offset 
    … …  
    257257         END IF 
    258258         ! return the simension size 
    259          IF( PRESENT(kdimsz) ) THEN  
     259         IF( PRESENT(kdimsz) ) THEN 
    260260            IF( i_nvd <= SIZE(kdimsz) ) THEN 
    261261               kdimsz(1:i_nvd) = iom_file(kiomid)%dimsz(1:i_nvd,kiv) 
    … …  
    267267         IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(kiv) 
    268268         IF( PRESENT( lduld) )  lduld  = iom_file(kiomid)%luld(kiv) 
    269       ELSE   
     269      ELSE 
    270270         iom_nf90_varid = -1   !   variable not found, return error code: -1 
    271271      ENDIF 
    … …  
    323323      INTEGER                    , INTENT(in   )           ::   kvid      ! Name of the variable 
    324324      INTEGER                    , INTENT(in   )           ::   knbdim    ! number of dimensions of the variable 
    325       INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart    ! start position of the reading in each axis  
     325      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart    ! start position of the reading in each axis 
    326326      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis 
    327327      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes 
    … …  
    529529      !!                   ***  SUBROUTINE  iom_nf90_rstput  *** 
    530530      !! 
    531       !! ** Purpose : read the time axis cdvar in the file  
     531      !! ** Purpose : read the time axis cdvar in the file 
    532532      !!-------------------------------------------------------------------- 
    533533      INTEGER                     , INTENT(in)           ::   kt       ! ocean time-step 
    534534      INTEGER                     , INTENT(in)           ::   kwrite   ! writing time-step 
    535       INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file  
     535      INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file 
    536536      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name 
    537537      INTEGER                     , INTENT(in)           ::   kvid     ! variable id 
    … …  
    544544      INTEGER               :: idims                ! number of dimension 
    545545      INTEGER               :: idvar                ! variable id 
    546       INTEGER               :: jd                   ! dimension loop counter    
    547       INTEGER               :: ix1, ix2, iy1, iy2   ! subdomain indexes    
    548       INTEGER, DIMENSION(4) :: idimsz               ! dimensions size   
     546      INTEGER               :: jd                   ! dimension loop counter 
     547      INTEGER               :: ix1, ix2, iy1, iy2   ! subdomain indexes 
     548      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size 
    549549      INTEGER, DIMENSION(4) :: idimid               ! dimensions id 
    550550      CHARACTER(LEN=256)    :: clinfo               ! info character 
    … …  
    678678            ELSEIF( idimsz(1) == jpi  .AND. idimsz(2) == jpj  ) THEN 
    679679               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj 
    680             ELSE  
     680            ELSE 
    681681               CALL ctl_stop( 'iom_nf90_rp0123d: should have been an impossible case...' ) 
    682682            ENDIF 
    … …  
    689689               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 2,                            gphit(ix1:ix2, iy1:iy2) ), clinfo ) 
    690690               SELECT CASE (iom_file(kiomid)%comp) 
    691                CASE ('OCE')   
     691               CASE ('OCE') 
    692692                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                           gdept_1d ), clinfo ) 
    693693               CASE ('ABL') 
    … …  
    697697               END SELECT 
    698698               ! "wrong" value: to be improved but not really useful... 
    699                CALL iom_nf90_check(   NF90_PUT_VAR( if90id, 4,                                                  kt ), clinfo )    
     699               CALL iom_nf90_check(   NF90_PUT_VAR( if90id, 4,                                                  kt ), clinfo ) 
    700700               ! update the size of the variable corresponding to the unlimited dimension 
    701701               iom_file(kiomid)%dimsz(1, 4) = 1   ! so we don't enter this IF case any more... 
    … …  
    720720         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok' 
    721721      ENDIF 
    722       !      
     722      ! 
    723723   END SUBROUTINE iom_nf90_rp0123d_dp 
    724724 

  • NEMO/trunk/src/OCE/IOM/prtctl.F90

    r13982 r14072  
    1515   IMPLICIT NONE 
    1616   PRIVATE 
    17     
     17 
    1818   INTEGER , DIMENSION(  :), ALLOCATABLE ::   numprt_oce, numprt_top 
    1919   INTEGER , DIMENSION(  :), ALLOCATABLE ::   nall_ictls, nall_ictle   ! first, last indoor index for each i-domain 
    … …  
    2222   REAL(wp), DIMENSION(  :), ALLOCATABLE ::   u_ctl , v_ctl            ! previous velocity trend values 
    2323   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   tra_ctl                  ! previous top trend values 
    24    !                                           
     24   ! 
    2525   PUBLIC prt_ctl         ! called by all subroutines 
    2626   PUBLIC prt_ctl_info    ! called by all subroutines 
    … …  
    3131   !!---------------------------------------------------------------------- 
    3232   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    33    !! $Id$  
     33   !! $Id$ 
    3434   !! Software governed by the CeCILL license (see ./LICENSE) 
    3535   !!---------------------------------------------------------------------- 
    … …  
    7070      !!                     ***  ROUTINE prt_ctl  *** 
    7171      !! 
    72       !! ** Purpose : - print sum control of 2D or 3D arrays over the same area  
     72      !! ** Purpose : - print sum control of 2D or 3D arrays over the same area 
    7373      !!                in mono and mpp case. This way can be usefull when 
    74       !!                debugging a new parametrization in mono or mpp.  
     74      !!                debugging a new parametrization in mono or mpp. 
    7575      !! 
    7676      !! ** Method  : 2 possibilities exist when setting the sn_cfctl%prtctl parameter to 
    7777      !!                .true. in the ocean namelist: 
    78       !!              - to debug a MPI run .vs. a mono-processor one;  
     78      !!              - to debug a MPI run .vs. a mono-processor one; 
    7979      !!                the control print will be done over each sub-domain. 
    80       !!                The nictl[se] and njctl[se] parameters in the namelist must  
     80      !!                The nictl[se] and njctl[se] parameters in the namelist must 
    8181      !!                be set to zero and [ij]splt to the corresponding splitted 
    8282      !!                domain in MPI along respectively i-, j- directions. 
    83       !!              - to debug a mono-processor run over the whole domain/a specific area;  
     83      !!              - to debug a mono-processor run over the whole domain/a specific area; 
    8484      !!                in the first case the nictl[se] and njctl[se] parameters must be set 
    8585      !!                to zero else to the indices of the area to be controled. In both cases 
    … …  
    8787      !!              - All arguments of the above calling sequence are optional so their 
    8888      !!                name must be explicitly typed if used. For instance if the 3D 
    89       !!                array tn(:,:,:) must be passed through the prt_ctl subroutine,  
     89      !!                array tn(:,:,:) must be passed through the prt_ctl subroutine, 
    9090      !!                it must look like: CALL prt_ctl(tab3d_1=tn). 
    9191      !! 
    … …  
    9999      !!                    mask2   : mask (3D) to apply to the tab[23]d_2 array 
    100100      !!                    clinfo2 : information about the tab[23]d_2 array 
    101       !!                    kdim    : k- direction for 3D arrays  
    102       !!                    clinfo3 : additional information  
     101      !!                    kdim    : k- direction for 3D arrays 
     102      !!                    clinfo3 : additional information 
    103103      !!---------------------------------------------------------------------- 
    104104      INTEGER                             , INTENT(in)           ::   ktab2d_1, ktab3d_1, ktab4d_1, ktab2d_2, ktab3d_2 
    … …  
    123123      !!---------------------------------------------------------------------- 
    124124      ! 
    125       ! Arrays, scalars initialization  
     125      ! Arrays, scalars initialization 
    126126      cl1  = '' 
    127127      cl2  = '' 
    … …  
    310310            WRITE(numout,*) '~~~~~~~~~~~~~' 
    311311         ENDIF 
    312          IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 )   THEN    ! print control done over the default area          
     312         IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 )   THEN    ! print control done over the default area 
    313313            nn_isplt = MAX(1, nn_isplt)            ! number of processors following i-direction 
    314314            nn_jsplt = MAX(1, nn_jsplt)            ! number of processors following j-direction 
    … …  
    391391      ENDIF 
    392392 
    393       ! Initialization  
     393      ! Initialization 
    394394      IF( clcomp == 'oce' ) THEN 
    395395         ALLOCATE( t_ctl(ijsplt), s_ctl(ijsplt), u_ctl(ijsplt), v_ctl(ijsplt), numprt_oce(ijsplt) ) 
    … …  
    424424         WRITE(inum,*) 
    425425         WRITE(inum,'(19x,a20)') cl_run 
    426          WRITE(inum,*)  
     426         WRITE(inum,*) 
    427427         WRITE(inum,*) 'prt_ctl :  Sum control indices' 
    428428         WRITE(inum,*) '~~~~~~~' 

  • NEMO/trunk/src/OCE/IOM/restart.F90

    r14053 r14072  
    1919   !!   rst_read   : read the ocean restart file 
    2020   !!---------------------------------------------------------------------- 
    21    USE oce             ! ocean dynamics and tracers  
     21   USE oce             ! ocean dynamics and tracers 
    2222   USE dom_oce         ! ocean space and time domain 
    23    USE sbc_ice         ! only lk_si3  
     23   USE sbc_ice         ! only lk_si3 
    2424   USE phycst          ! physical constants 
    2525   USE eosbn2          ! equation of state            (eos bn2 routine) 
    … …  
    4949      !!--------------------------------------------------------------------- 
    5050      !!                   ***  ROUTINE rst_opn  *** 
    51       !!                      
    52       !! ** Purpose : + initialization (should be read in the namelist) of nitrst  
     51      !! 
     52      !! ** Purpose : + initialization (should be read in the namelist) of nitrst 
    5353      !!              + open the restart when we are one time step before nitrst 
    5454      !!                   - restart header is defined when kt = nitrst-1 
    … …  
    6666      ! 
    6767      IF( kt == nit000 ) THEN   ! default definitions 
    68          lrst_oce = .FALSE.    
     68         lrst_oce = .FALSE. 
    6969         IF( ln_rst_list ) THEN 
    7070            nrst_lst = 1 
    … …  
    7474         ENDIF 
    7575      ENDIF 
    76        
     76 
    7777      IF( .NOT. ln_rst_list .AND. nn_stock == -1 )   RETURN   ! we will never do any restart 
    7878 
    7979      ! frequency-based restart dumping (nn_stock) 
    80       IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN    
     80      IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN 
    8181         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
    8282         nitrst = kt + nn_stock - 1                  ! define the next value of nitrst for restart writing 
    … …  
    8787      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1 
    8888      IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 
    89          IF( nitrst <= nitend .AND. nitrst > 0 ) THEN  
     89         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
    9090            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    9191            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    … …  
    115115                  clpname = clname 
    116116               ELSE 
    117                   clpname = TRIM(Agrif_CFixed())//"_"//clname    
     117                  clpname = TRIM(Agrif_CFixed())//"_"//clname 
    118118               ENDIF 
    119119               numrow = iom_xios_setid(TRIM(clpath)//TRIM(clpname)) 
    … …  
    135135      !!--------------------------------------------------------------------- 
    136136      !!                   ***  ROUTINE rstwrite  *** 
    137       !!                      
     137      !! 
    138138      !! ** Purpose :   Write restart fields in NetCDF format 
    139139      !! 
    … …  
    164164                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      ) 
    165165      ENDIF 
    166        
    167       IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst )   
     166 
     167      IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst ) 
    168168      IF( kt == nitrst ) THEN 
    169169         IF(.NOT.lwxios) THEN 
    … …  
    187187 
    188188   SUBROUTINE rst_read_open 
    189       !!----------------------------------------------------------------------  
     189      !!---------------------------------------------------------------------- 
    190190      !!                   ***  ROUTINE rst_read_open  *** 
    191       !!  
     191      !! 
    192192      !! ** Purpose :   Open read files for NetCDF restart 
    193       !!  
     193      !! 
    194194      !! ** Method  :   Use a non-zero, positive value of numror to assess whether or not 
    195195      !!                the file has already been opened 
    … …  
    222222!               clpname = cn_ocerst_in 
    223223!            ELSE 
    224 !               clpname = TRIM(Agrif_CFixed())//"_"//cn_ocerst_in    
     224!               clpname = TRIM(Agrif_CFixed())//"_"//cn_ocerst_in 
    225225!            ENDIF 
    226226             CALL iom_init( cr_ocerst_cxt, kdid = numror, ld_closedef = .TRUE. ) 
    … …  
    234234 
    235235   SUBROUTINE rst_read( Kbb, Kmm ) 
    236       !!----------------------------------------------------------------------  
     236      !!---------------------------------------------------------------------- 
    237237      !!                   ***  ROUTINE rst_read  *** 
    238       !!  
     238      !! 
    239239      !! ** Purpose :   Read velocity and T-S fields in the restart file 
    240       !!  
     240      !! 
    241241      !! ** Method  :   Read in restart.nc fields which are necessary for restart 
    242242      !! 
    … …  
    255255      IF(.NOT.lrxios ) CALL iom_delay_rst( 'READ', 'OCE', numror )   ! read only ocean delayed global communication variables 
    256256      ! 
    257       !                             !*  Diurnal DSST  
    258       IF( ln_diurnal )   CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst )  
    259       IF ( ln_diurnal_only ) THEN  
     257      !                             !*  Diurnal DSST 
     258      IF( ln_diurnal )   CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst ) 
     259      IF ( ln_diurnal_only ) THEN 
    260260         IF(lwp) WRITE( numout, * ) & 
    261          &   "rst_read:- ln_diurnal_only set, setting rhop=rho0"  
     261         &   "rst_read:- ln_diurnal_only set, setting rhop=rho0" 
    262262         rhop = rho0 
    263          CALL iom_get( numror, jpdom_auto, 'tn'     , w3d )  
     263         CALL iom_get( numror, jpdom_auto, 'tn'     , w3d ) 
    264264         ts(:,:,1,jp_tem,Kmm) = w3d(:,:,1) 
    265          RETURN  
    266       ENDIF   
     265         RETURN 
     266      ENDIF 
    267267      ! 
    268268      !                             !*  Read Kmm fields 
    … …  
    289289         CALL iom_get( numror, jpdom_auto, 'rhop'   , rhop )   ! now    potential density 
    290290      ELSE 
    291          CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) )    
     291         CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) ) 
    292292      ENDIF 
    293293      ! 

  • NEMO/trunk/src/OCE/ISF/isfcav.F90

    r13970 r14072  
    7979      CALL isf_tbl(Kmm, ts(:,:,:,jp_tem,Kmm), zttbl(:,:),'T', misfkt_cav, rhisf_tbl_cav, misfkb_cav, rfrac_tbl_cav ) 
    8080      CALL isf_tbl(Kmm, ts(:,:,:,jp_sal,Kmm), zstbl(:,:),'T', misfkt_cav, rhisf_tbl_cav, misfkb_cav, rfrac_tbl_cav ) 
    81       !  
     81      ! 
    8282      ! output T/S/U/V for the top boundary layer 
    8383      CALL iom_put('ttbl_cav',zttbl(:,:) * mskisf_cav(:,:)) 
    … …  
    9797               &                                    zgammat, zgammas ) 
    9898         END IF 
    99          !    
     99         ! 
    100100         ! compute tfrz, latent heat and melt (2d) 
    101101         CALL isfcav_mlt(kt, zgammat, zgammas, zttbl, zstbl, & 

  • NEMO/trunk/src/OCE/ISF/isfcpl.F90

    r14053 r14072  
    3030   PRIVATE 
    3131 
    32    PUBLIC isfcpl_rst_write, isfcpl_init                    ! iceshelf restart read and write  
    33    PUBLIC isfcpl_ssh, isfcpl_tra, isfcpl_vol, isfcpl_cons  ! iceshelf correction for ssh, tra, dyn and conservation  
     32   PUBLIC isfcpl_rst_write, isfcpl_init                    ! iceshelf restart read and write 
     33   PUBLIC isfcpl_ssh, isfcpl_tra, isfcpl_vol, isfcpl_cons  ! iceshelf correction for ssh, tra, dyn and conservation 
    3434 
    3535   TYPE isfcons 
    … …  
    5757      !!--------------------------------------------------------------------- 
    5858      !!                   ***  ROUTINE iscpl_init  *** 
    59       !!  
    60       !! ** Purpose : correct ocean state for new wet cell and horizontal divergence  
     59      !! 
     60      !! ** Purpose : correct ocean state for new wet cell and horizontal divergence 
    6161      !!              correction for the dynamical adjustement 
    6262      !! 
    … …  
    7474      ! start on an euler time step 
    7575      l_1st_euler = .TRUE. 
    76       !  
     76      ! 
    7777      ! allocation and initialisation to 0 
    7878      CALL isf_alloc_cpl() 
    … …  
    8888      IF(lwp) WRITE(numout,*) ' isfcpl_init:', id 
    8989      IF (id == 0) THEN 
    90          IF(lwp) WRITE(numout,*) ' isfcpl_init: restart variables for ice sheet coupling are missing, skip coupling for this leg '  
     90         IF(lwp) WRITE(numout,*) ' isfcpl_init: restart variables for ice sheet coupling are missing, skip coupling for this leg ' 
    9191         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 
    9292         IF(lwp) WRITE(numout,*) '' 
    … …  
    119119#if ! defined key_qco 
    120120      e3t(:,:,:,Kbb)   = e3t(:,:,:,Kmm) 
    121 #endif  
     121#endif 
    122122   END SUBROUTINE isfcpl_init 
    123123 
    124     
     124 
    125125   SUBROUTINE isfcpl_rst_write( kt, Kmm ) 
    126126      !!--------------------------------------------------------------------- 
    127127      !!                   ***  ROUTINE iscpl_rst_write  *** 
    128       !!  
     128      !! 
    129129      !! ** Purpose : write icesheet coupling variables in restart 
    130130      !! 
    … …  
    143143         ! 
    144144         zgdepw(:,:,jk) = gdepw(:,:,jk,Kmm) 
    145       END DO  
     145      END DO 
    146146      ! 
    147147      CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask  ) 
    … …  
    154154   END SUBROUTINE isfcpl_rst_write 
    155155 
    156     
     156 
    157157   SUBROUTINE isfcpl_ssh(Kbb, Kmm, Kaa) 
    158       !!----------------------------------------------------------------------  
     158      !!---------------------------------------------------------------------- 
    159159      !!                   ***  ROUTINE iscpl_ssh  *** 
    160       !!  
     160      !! 
    161161      !! ** Purpose :   basic guess of ssh in new wet cell 
    162       !!  
     162      !! 
    163163      !! ** Method  :   basic extrapolation from neigbourg cells 
    164164      !! 
    … …  
    176176      CALL iom_get( numror, jpdom_auto, 'ssmask'  , zssmask_b   ) ! need to extrapolate T/S 
    177177 
    178       ! compute new ssh if we open a full water column  
     178      ! compute new ssh if we open a full water column 
    179179      ! rude average of the closest neigbourgs (e1e2t not taking into account) 
    180180      ! 
    … …  
    229229   END SUBROUTINE isfcpl_ssh 
    230230 
    231     
     231 
    232232   SUBROUTINE isfcpl_tra(Kmm) 
    233       !!----------------------------------------------------------------------  
     233      !!---------------------------------------------------------------------- 
    234234      !!                   ***  ROUTINE iscpl_tra  *** 
    235       !!  
    236       !! ** Purpose :   compute new tn, sn in case of evolving geometry of ice shelves  
    237       !!  
     235      !! 
     236      !! ** Purpose :   compute new tn, sn in case of evolving geometry of ice shelves 
     237      !! 
    238238      !! ** Method  :   tn, sn : basic extrapolation from neigbourg cells 
    239239      !! 
    … …  
    250250      REAL(wp):: zdz, zdzm1, zdzp1 
    251251      !! 
    252       REAL(wp), DIMENSION(jpi,jpj)          :: zdmask  
     252      REAL(wp), DIMENSION(jpi,jpj)          :: zdmask 
    253253      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask0, zwmaskn 
    254254      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask1, zwmaskb, ztmp3d 
    255255      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts0 
    256256      !!---------------------------------------------------------------------- 
    257       !  
     257      ! 
    258258      CALL iom_get( numror, jpdom_auto, 'tmask'  , ztmask_b   ) ! need to extrapolate T/S 
    259259      !CALL iom_get( numror, jpdom_auto, 'wmask'  , zwmask_b  ) ! need to extrapolate T/S 
    260260      !CALL iom_get( numror, jpdom_auto, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl) 
    261261      ! 
    262       !  
     262      ! 
    263263      ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask 
    264264      !PM: Is this IF needed since change to VVL by default 
    … …  
    376376            &                         in your domain cfg computation'         ) 
    377377      END_3D 
    378       !  
     378      ! 
    379379   END SUBROUTINE isfcpl_tra 
    380     
     380 
    381381 
    382382   SUBROUTINE isfcpl_vol(Kmm) 
    383       !!----------------------------------------------------------------------  
     383      !!---------------------------------------------------------------------- 
    384384      !!                   ***  ROUTINE iscpl_vol  *** 
    385       !!  
    386       !! ** Purpose : compute the correction of the local divergence to apply   
     385      !! 
     386      !! ** Purpose : compute the correction of the local divergence to apply 
    387387      !!              during the first time step after the coupling. 
    388388      !! 
    … …  
    390390      !!              - compute vertical input 
    391391      !!              - compute correction 
    392       !!                 
     392      !! 
    393393      !!---------------------------------------------------------------------- 
    394394      !! 
    395395      INTEGER, INTENT(in) :: Kmm    ! ocean time level index 
    396396      !!---------------------------------------------------------------------- 
    397       INTEGER :: ji, jj, jk  
     397      INTEGER :: ji, jj, jk 
    398398      INTEGER :: ikb, ikt 
    399399      !! 
    … …  
    421421         ! 
    422422         ! 1.2: get volume flux after coupling (>0 out) 
    423          ! properly mask velocity  
     423         ! properly mask velocity 
    424424         ! (velocity are still mask with old mask at this stage) 
    425425         uu(:,:,jk,Kmm) = uu(:,:,jk,Kmm) * umask(:,:,jk) 
    … …  
    459459      ! 
    460460      ! 3.2: get 3d tr(:,:,:,:,Krhs) increment to apply at the first time step 
    461       ! temperature and salt content flux computed using local ts(:,:,:,:,Kmm)  
     461      ! temperature and salt content flux computed using local ts(:,:,:,:,Kmm) 
    462462      ! (very simple advection scheme) 
    463463      ! (>0 out) 
    … …  
    473473   END SUBROUTINE isfcpl_vol 
    474474 
    475     
     475 
    476476   SUBROUTINE isfcpl_cons(Kmm) 
    477       !!----------------------------------------------------------------------  
     477      !!---------------------------------------------------------------------- 
    478478      !!                   ***  ROUTINE iscpl_cons  *** 
    479       !!  
     479      !! 
    480480      !! ** Purpose :   compute the corrective increment in volume/salt/heat to put back the vol/heat/salt 
    481481      !!                removed or added during the coupling processes (wet or dry new cell) 
    482       !!  
     482      !! 
    483483      !! ** Method  :   - compare volume/heat/salt before and after 
    484484      !!                - look for the closest wet cells (share amoung neigbourgs if there are) 
    485485      !!                - build the correction increment to applied at each time step 
    486       !!                 
     486      !! 
    487487      !!---------------------------------------------------------------------- 
    488488      ! 
    … …  
    496496      INTEGER  ::   iig  , ijg, ik                    ! dummy indices 
    497497      INTEGER  ::   jisf                              ! start, end and current position in the increment array 
    498       INTEGER  ::   ingb, ifind                       ! 0/1 target found or need to be found  
    499       INTEGER  ::   nisfl_area                        ! global number of cell concerned by the wet->dry case  
     498      INTEGER  ::   ingb, ifind                       ! 0/1 target found or need to be found 
     499      INTEGER  ::   nisfl_area                        ! global number of cell concerned by the wet->dry case 
    500500      INTEGER, DIMENSION(jpnij) :: nisfl              ! local  number of cell concerned by the wet->dry case 
    501501      ! 
    502502      REAL(wp) ::   z1_sum, z1_rdtiscpl 
    503503      REAL(wp) ::   zdtem, zdsal, zdvol, zratio       ! tem, sal, vol increment 
    504       REAL(wp) ::   zlon , zlat                       ! target location   
     504      REAL(wp) ::   zlon , zlat                       ! target location 
    505505      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b    ! mask before 
    506506      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t_b      ! scale factor before 
    … …  
    522522      nstp_iscpl  = nitend - nit000 + 1 
    523523      rdt_iscpl   = nstp_iscpl * rn_Dt 
    524       z1_rdtiscpl = 1._wp / rdt_iscpl  
     524      z1_rdtiscpl = 1._wp / rdt_iscpl 
    525525 
    526526      IF (lwp) WRITE(numout,*) '            nb of stp for cons  = ', nstp_iscpl 
    … …  
    552552               zdsal = ts(ji,jj,jk,jp_sal,Kmm) *  e3t(ji,jj,jk,Kmm) *  tmask  (ji,jj,jk)   & 
    553553                     - zs_b(ji,jj,jk)       * ze3t_b(ji,jj,jk) * ztmask_b(ji,jj,jk) 
    554              
     554 
    555555               ! volume, heat and salt differences in each cell (>0 means correction is an outward flux) 
    556556               ! in addition to the geometry change unconservation, need to add the divergence correction as it is flux across the boundary 
    … …  
    575575            DO ji = Nis0,Nie0 
    576576               jip1=MIN(ji+1,jpi) ; jim1=MAX(ji-1,1) ; jjp1=MIN(jj+1,jpj) ; jjm1=MAX(jj-1,1) ; 
    577                IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) THEN  
     577               IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) THEN 
    578578                  nisfl(narea) = nisfl(narea) + MAX(SUM(tmask(jim1:jip1,jjm1:jjp1,jk)),1._wp) 
    579579               ENDIF 
    … …  
    582582      ENDDO 
    583583      ! 
    584       ! global  
     584      ! global 
    585585      CALL mpp_sum('isfcpl',nisfl  ) 
    586586      ! 
    … …  
    636636      ! share data among all processes because for some point we need to find the closest wet point (could be on other process) 
    637637      DO jproc=1,jpnij 
    638          !  
     638         ! 
    639639         ! share total number of isf point treated for proc jproc 
    640640         IF (jproc==narea) THEN 
    … …  
    660660               ingb = zisfpts(jisf)%ngb 
    661661            ELSE 
    662                iig  =0   ; ijg  =0   ; ik   =0   
     662               iig  =0   ; ijg  =0   ; ik   =0 
    663663               zdvol=-HUGE(1.0) ; zdsal=-HUGE(1.0) ; zdtem=-HUGE(1.0) 
    664                zlat =-HUGE(1.0) ; zlon =-HUGE(1.0)    
     664               zlat =-HUGE(1.0) ; zlon =-HUGE(1.0) 
    665665               ingb = 0 
    666666            END IF 
    … …  
    711711      INTEGER,                     INTENT(inout) :: kpts 
    712712      !!---------------------------------------------------------------------- 
    713       INTEGER,      INTENT(in   )           :: ki, kj, kk                  !    target location (kfind=0)  
     713      INTEGER,      INTENT(in   )           :: ki, kj, kk                  !    target location (kfind=0) 
    714714      !                                                                    ! or source location (kfind=1) 
    715715      INTEGER,      INTENT(in   ), OPTIONAL :: kfind                       ! 0  target cell already found 
    716716      !                                                                    ! 1  target to be determined 
    717       REAL(wp),     INTENT(in   )           :: pdvol, pdsal, pdtem, pratio ! vol/sal/tem increment  
     717      REAL(wp),     INTENT(in   )           :: pdvol, pdsal, pdtem, pratio ! vol/sal/tem increment 
    718718      !                                                                    ! and ratio in case increment span over multiple cells. 
    719719      !!---------------------------------------------------------------------- 
    720720      INTEGER :: ifind 
    721721      !!---------------------------------------------------------------------- 
    722       !  
     722      ! 
    723723      ! increment position 
    724724      kpts = kpts + 1 

  • NEMO/trunk/src/OCE/ISF/isfrst.F90

    r14053 r14072  
    2020   PRIVATE 
    2121 
    22    PUBLIC isfrst_read, isfrst_write ! iceshelf restart read and write  
     22   PUBLIC isfrst_read, isfrst_write ! iceshelf restart read and write 
    2323 
    2424   !!---------------------------------------------------------------------- 
    … …  
    2828   !!---------------------------------------------------------------------- 
    2929CONTAINS 
    30     
     30 
    3131   SUBROUTINE isfrst_read( cdisf, ptsc, pfwf, ptsc_b, pfwf_b ) 
    3232      !!--------------------------------------------------------------------- 
    … …  
    6363   END SUBROUTINE isfrst_read 
    6464 
    65     
     65 
    6666   SUBROUTINE isfrst_write( kt, cdisf, ptsc, pfwf ) 
    6767      !!--------------------------------------------------------------------- 
    … …  
    9595      ! 
    9696   END SUBROUTINE isfrst_write 
    97     
     97 
    9898   !!====================================================================== 
    9999END MODULE isfrst 

  • NEMO/trunk/src/OCE/LBC/lbclnk.F90

    r13982 r14072  
    66   !! History :  OPA  ! 1997-06  (G. Madec)  Original code 
    77   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module 
    8    !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment   
     8   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment 
    99   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco)  optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk 
    10    !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case   
    11    !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi   
     10   !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case 
     11   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi 
    1212   !!            4.0  ! 2017-03  (G. Madec) automatique allocation of array size (use with any 3rd dim size) 
    1313   !!             -   ! 2017-04  (G. Madec) remove duplicated routines (lbc_lnk_2d_9, lbc_lnk_2d_multiple, lbc_lnk_3d_gather) 
    … …  
    5757      MODULE PROCEDURE   mpp_nfd_2d_ptr_sp, mpp_nfd_3d_ptr_sp, mpp_nfd_4d_ptr_sp 
    5858      MODULE PROCEDURE   mpp_nfd_2d_ptr_dp, mpp_nfd_3d_ptr_dp, mpp_nfd_4d_ptr_dp 
    59        
     59 
    6060   END INTERFACE 
    6161 
    … …  
    527527#     include "mpp_lbc_north_icb_generic.h90" 
    528528#     undef ROUTINE_LNK 
    529   
     529 
    530530 
    531531      !!---------------------------------------------------------------------- 
    … …  
    559559#     include "mpp_lnk_icb_generic.h90" 
    560560#     undef ROUTINE_LNK 
    561    
     561 
    562562END MODULE lbclnk 
    563  

  • NEMO/trunk/src/OCE/LBC/lib_mpp.F90

    r13982 r14072  
    2020   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager 
    2121   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add mpp_lnk_bdy_3d/2d routines to optimize the BDY comm. 
    22    !!            3.5  !  2013  (C. Ethe, G. Madec)  message passing arrays as local variables  
     22   !!            3.5  !  2013  (C. Ethe, G. Madec)  message passing arrays as local variables 
    2323   !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations 
    2424   !!            3.6  !  2015  (O. Tintó and M. Castrillo - BSC) Added '_multiple' case for 2D lbc and max 
    … …  
    7777   PUBLIC MPI_Wtime 
    7878#endif 
    79     
     79 
    8080   !! * Interfaces 
    8181   !! define generic interface for these routine as they are called sometimes 
    … …  
    115115!$AGRIF_END_DO_NOT_TREAT 
    116116   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag 
    117 #else    
     117#else 
    118118   INTEGER, PUBLIC, PARAMETER ::   MPI_STATUS_SIZE = 1 
    119119   INTEGER, PUBLIC, PARAMETER ::   MPI_REAL = 4 
    … …  
    183183   REAL(dp), DIMENSION(2), PUBLIC ::  waiting_time = 0._dp 
    184184   REAL(dp)              , PUBLIC ::  compute_time = 0._dp, elapsed_time = 0._dp 
    185     
     185 
    186186   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend 
    187187 
    188188   LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms 
    189189   LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms 
    190     
     190 
    191191   !! * Substitutions 
    192192#  include "do_loop_substitute.h90" 
    … …  
    223223         IF( ierr /= MPI_SUCCESS ) CALL ctl_stop( 'STOP', ' lib_mpp: Error in routine mpi_init' ) 
    224224      ENDIF 
    225         
     225 
    226226      IF( PRESENT(localComm) ) THEN 
    227227         IF( Agrif_Root() ) THEN 
    … …  
    473473   END SUBROUTINE mppscatter 
    474474 
    475     
     475 
    476476   SUBROUTINE mpp_delay_sum( cdname, cdelay, y_in, pout, ldlast, kcom ) 
    477477     !!---------------------------------------------------------------------- 
    … …  
    498498 
    499499      isz = SIZE(y_in) 
    500        
     500 
    501501      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_dlg = .TRUE. ) 
    502502 
    … …  
    519519         END IF 
    520520      ENDIF 
    521        
     521 
    522522      IF( ndelayid(idvar) == -1 ) THEN         ! first call without restart: define %y1d and %z1d from y_in with blocking allreduce 
    523523         !                                       -------------------------- 
    … …  
    547547   END SUBROUTINE mpp_delay_sum 
    548548 
    549     
     549 
    550550   SUBROUTINE mpp_delay_max( cdname, cdelay, p_in, pout, ldlast, kcom ) 
    551551      !!---------------------------------------------------------------------- 
    … …  
    557557      CHARACTER(len=*), INTENT(in   )                 ::   cdname  ! name of the calling subroutine 
    558558      CHARACTER(len=*), INTENT(in   )                 ::   cdelay  ! name (used as id) of the delayed operation 
    559       REAL(wp),         INTENT(in   ), DIMENSION(:)   ::   p_in    !  
    560       REAL(wp),         INTENT(  out), DIMENSION(:)   ::   pout    !  
     559      REAL(wp),         INTENT(in   ), DIMENSION(:)   ::   p_in    ! 
     560      REAL(wp),         INTENT(  out), DIMENSION(:)   ::   pout    ! 
    561561      LOGICAL,          INTENT(in   )                 ::   ldlast  ! true if this is the last time we call this routine 
    562562      INTEGER,          INTENT(in   ), OPTIONAL       ::   kcom 
    … …  
    567567      INTEGER ::   MPI_TYPE 
    568568      !!---------------------------------------------------------------------- 
    569        
     569 
    570570#if defined key_mpp_mpi 
    571571      if( wp == dp ) then 
    … …  
    575575      else 
    576576        CALL ctl_stop( "Error defining type, wp is neither dp nor sp" ) 
    577     
     577 
    578578      end if 
    579579 
    … …  
    629629   END SUBROUTINE mpp_delay_max 
    630630 
    631     
     631 
    632632   SUBROUTINE mpp_delay_rcv( kid ) 
    633633      !!---------------------------------------------------------------------- 
    634634      !!                   ***  routine mpp_delay_rcv  *** 
    635635      !! 
    636       !! ** Purpose :  force barrier for delayed mpp (needed for restart)  
    637       !! 
    638       !!---------------------------------------------------------------------- 
    639       INTEGER,INTENT(in   )      ::  kid  
     636      !! ** Purpose :  force barrier for delayed mpp (needed for restart) 
     637      !! 
     638      !!---------------------------------------------------------------------- 
     639      INTEGER,INTENT(in   )      ::  kid 
    640640      INTEGER ::   ierr 
    641641      !!---------------------------------------------------------------------- 
    … …  
    674674   END SUBROUTINE mpp_bcast_nml 
    675675 
    676     
     676 
    677677   !!---------------------------------------------------------------------- 
    678678   !!    ***  mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real  *** 
    679    !!    
     679   !! 
    680680   !!---------------------------------------------------------------------- 
    681681   !! 
    … …  
    729729   !!---------------------------------------------------------------------- 
    730730   !!    ***  mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real  *** 
    731    !!    
     731   !! 
    732732   !!---------------------------------------------------------------------- 
    733733   !! 
    … …  
    781781   !!---------------------------------------------------------------------- 
    782782   !!    ***  mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real  *** 
    783    !!    
     783   !! 
    784784   !!   Global sum of 1D array or a variable (integer, real or complex) 
    785785   !!---------------------------------------------------------------------- 
    … …  
    855855   !!---------------------------------------------------------------------- 
    856856   !!    ***  mpp_minloc2d, mpp_minloc3d, mpp_maxloc2d, mpp_maxloc3d 
    857    !!    
     857   !! 
    858858   !!---------------------------------------------------------------------- 
    859859   !! 
    … …  
    935935 
    936936 
    937    SUBROUTINE mppstop( ld_abort )  
     937   SUBROUTINE mppstop( ld_abort ) 
    938938      !!---------------------------------------------------------------------- 
    939939      !!                  ***  routine mppstop  *** 
    … …  
    10801080      !!                collectives 
    10811081      !! 
    1082       !! ** Method  : - Create graph communicators starting from the processes    
     1082      !! ** Method  : - Create graph communicators starting from the processes 
    10831083      !!                distribution along i and j directions 
    10841084      ! 
    … …  
    14111411                  jj = 0 
    14121412               END IF 
    1413                jj = jj + 1  
     1413               jj = jj + 1 
    14141414            END DO 
    14151415            WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_glb(n_sequence_glb)) 
    … …  
    14271427                  jj = 0 
    14281428               END IF 
    1429                jj = jj + 1  
     1429               jj = jj + 1 
    14301430            END DO 
    14311431            WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_dlg(n_sequence_dlg)) 
    … …  
    14431443   END SUBROUTINE mpp_report 
    14441444 
    1445     
     1445 
    14461446   SUBROUTINE tic_tac (ld_tic, ld_global) 
    14471447 
    … …  
    14591459       IF( ld_global ) ii = 2 
    14601460    END IF 
    1461      
     1461 
    14621462    IF ( ld_tic ) THEN 
    14631463       tic_wt(ii) = MPI_Wtime()                                                    ! start count tic->tac (waiting time) 
    … …  
    14681468    ENDIF 
    14691469#endif 
    1470      
     1470 
    14711471   END SUBROUTINE tic_tac 
    14721472 
    … …  
    14781478   END SUBROUTINE mpi_wait 
    14791479 
    1480     
     1480 
    14811481   FUNCTION MPI_Wtime() 
    14821482      REAL(wp) ::  MPI_Wtime 
    … …  
    15401540      ! 
    15411541      IF( cd1 == 'STOP' ) THEN 
    1542          WRITE(numout,*)   
     1542         WRITE(numout,*) 
    15431543         WRITE(numout,*)  'huge E-R-R-O-R : immediate stop' 
    1544          WRITE(numout,*)   
     1544         WRITE(numout,*) 
    15451545         CALL FLUSH(numout) 
    15461546         CALL SLEEP(60)   ! make sure that all output and abort files are written by all cores. 60s should be enough... 
    … …  
    16391639      ENDIF 
    16401640      IF( iost /= 0 .AND. TRIM(clfile) == '/dev/null' ) &   ! for windows 
    1641          &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost )    
     1641         &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost ) 
    16421642      IF( iost == 0 ) THEN 
    16431643         IF(ldwp .AND. kout > 0) THEN 
    … …  
    16811681      ! 
    16821682      WRITE (clios, '(I5.0)')   kios 
    1683       IF( kios < 0 ) THEN          
     1683      IF( kios < 0 ) THEN 
    16841684         CALL ctl_warn( 'end of record or file while reading namelist '   & 
    16851685            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) ) 
    … …  
    17271727      !csp = NEW_LINE('A') 
    17281728      ! a new line character is the best seperator but some systems (e.g.Cray) 
    1729       ! seem to terminate namelist reads from internal files early if they  
     1729      ! seem to terminate namelist reads from internal files early if they 
    17301730      ! encounter new-lines. Use a single space for safety. 
    17311731      csp = ' ' 
    … …  
    17461746         iltc = LEN_TRIM(chline) 
    17471747         IF ( iltc.GT.0 ) THEN 
    1748           inl = INDEX(chline, '!')  
     1748          inl = INDEX(chline, '!') 
    17491749          IF( inl.eq.0 ) THEN 
    17501750           itot = itot + iltc + 1                                ! +1 for the newline character 

  • NEMO/trunk/src/OCE/LBC/mpp_lnk_generic.h90

    r13982 r14072  
    11#if defined MULTI 
    2 #   define NAT_IN(k)                cd_nat(k)    
     2#   define NAT_IN(k)                cd_nat(k) 
    33#   define SGN_IN(k)                psgn(k) 
    44#   define F_SIZE(ptab)             kfld 
    … …  
    4343#   define SGN_IN(k)                psgn 
    4444#   define F_SIZE(ptab)             1 
    45 #   define OPT_K(k)                  
     45#   define OPT_K(k) 
    4646#   if defined DIM_2d 
    4747#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j) 
    … …  
    9797      REAL(PRECISION), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsnd_so, zrcv_so, zsnd_no, zrcv_no   ! north-south & south-north  halos 
    9898      LOGICAL  ::   llsend_we, llsend_ea, llsend_no, llsend_so       ! communication send 
    99       LOGICAL  ::   llrecv_we, llrecv_ea, llrecv_no, llrecv_so       ! communication receive  
     99      LOGICAL  ::   llrecv_we, llrecv_ea, llrecv_no, llrecv_so       ! communication receive 
    100100      LOGICAL  ::   lldo_nfd                                     ! do north pole folding 
    101101      !!---------------------------------------------------------------------- 
    … …  
    133133         llrecv_we = llsend_we   ;   llrecv_ea = llsend_ea   ;   llrecv_so = llsend_so   ;   llrecv_no = llsend_no 
    134134      END IF 
    135           
    136           
     135 
     136 
    137137      lldo_nfd = npolj /= 0                      ! keep for compatibility, should be defined in mppini 
    138138 
    … …  
    178178      ! 
    179179      ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg 
    180       isize = nn_hls * jpj * ipk * ipl * ipf       
     180      isize = nn_hls * jpj * ipk * ipl * ipf 
    181181      ! 
    182182      ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    … …  
    220220      ! ishift = 0                         ! fill halo from ji = 1 to nn_hls 
    221221      SELECT CASE ( ifill_we ) 
    222       CASE ( jpfillnothing )               ! no filling  
    223       CASE ( jpfillmpi   )                 ! use data received by MPI  
     222      CASE ( jpfillnothing )               ! no filling 
     223      CASE ( jpfillmpi   )                 ! use data received by MPI 
    224224         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    225225            ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf)   ! 1 -> nn_hls 
    … …  
    242242      ! 2.2 fill eastern halo 
    243243      ! --------------------- 
    244       ishift = jpi - nn_hls                ! fill halo from ji = jpi-nn_hls+1 to jpi  
     244      ishift = jpi - nn_hls                ! fill halo from ji = jpi-nn_hls+1 to jpi 
    245245      SELECT CASE ( ifill_ea ) 
    246       CASE ( jpfillnothing )               ! no filling  
    247       CASE ( jpfillmpi   )                 ! use data received by MPI  
     246      CASE ( jpfillnothing )               ! no filling 
     247      CASE ( jpfillmpi   )                 ! use data received by MPI 
    248248         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    249249            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf)   ! jpi - nn_hls + 1 -> jpi 
    … …  
    290290      IF( llrecv_no )   ALLOCATE( zrcv_no(jpi,nn_hls,ipk,ipl,ipf) ) 
    291291      ! 
    292       isize = jpi * nn_hls * ipk * ipl * ipf       
     292      isize = jpi * nn_hls * ipk * ipl * ipf 
    293293 
    294294      ! allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    … …  
    326326      ! ishift = 0                         ! fill halo from jj = 1 to nn_hls 
    327327      SELECT CASE ( ifill_so ) 
    328       CASE ( jpfillnothing )               ! no filling  
    329       CASE ( jpfillmpi   )                 ! use data received by MPI  
     328      CASE ( jpfillnothing )               ! no filling 
     329      CASE ( jpfillmpi   )                 ! use data received by MPI 
    330330         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    331331            ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf)   ! 1 -> nn_hls 
    … …  
    341341         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    342342      CASE ( jpfillcst   )                 ! filling with constant value 
    343          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi  
     343         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    344344            ARRAY_IN(ji,jj,jk,jl,jf) = zland 
    345345         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    … …  
    348348      ! 5.2 fill northern halo 
    349349      ! ---------------------- 
    350       ishift = jpj - nn_hls                ! fill halo from jj = jpj-nn_hls+1 to jpj  
     350      ishift = jpj - nn_hls                ! fill halo from jj = jpj-nn_hls+1 to jpj 
    351351      SELECT CASE ( ifill_no ) 
    352       CASE ( jpfillnothing )               ! no filling  
    353       CASE ( jpfillmpi   )                 ! use data received by MPI  
     352      CASE ( jpfillnothing )               ! no filling 
     353      CASE ( jpfillmpi   )                 ! use data received by MPI 
    354354         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    355355            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf)   ! jpj-nn_hls+1 -> jpj 

  • NEMO/trunk/src/OCE/LBC/mppini.F90

    r14053 r14072  
    99   !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1 
    1010   !!            3.4  !  2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)  add init_nfdcom 
    11    !!            3.   !  2013-06  (I. Epicoco, S. Mocavero, CMCC)  init_nfdcom: setup avoiding MPI communication  
     11   !!            3.   !  2013-06  (I. Epicoco, S. Mocavero, CMCC)  init_nfdcom: setup avoiding MPI communication 
    1212   !!            4.0  !  2016-06  (G. Madec)  use domain configuration file instead of bathymetry file 
    1313   !!            4.0  !  2017-06  (J.M. Molines, T. Lovato) merge of mppini and mppini_2 
    … …  
    1616   !!---------------------------------------------------------------------- 
    1717   !!  mpp_init       : Lay out the global domain over processors with/without land processor elimination 
    18    !!      init_ioipsl: IOIPSL initialization in mpp  
     18   !!      init_ioipsl: IOIPSL initialization in mpp 
    1919   !!      init_nfdcom: Setup for north fold exchanges with explicit point-to-point messaging 
    20    !!      init_doloop: set the starting/ending indices of DO-loop used in do_loop_substitute  
     20   !!      init_doloop: set the starting/ending indices of DO-loop used in do_loop_substitute 
    2121   !!---------------------------------------------------------------------- 
    2222   USE dom_oce        ! ocean space and time domain 
    23    USE bdy_oce        ! open BounDarY   
     23   USE bdy_oce        ! open BounDarY 
    2424   ! 
    25    USE lbcnfd  , ONLY : isendto, nsndto ! Setup of north fold exchanges  
     25   USE lbcnfd  , ONLY : isendto, nsndto ! Setup of north fold exchanges 
    2626   USE lib_mpp        ! distribued memory computing library 
    27    USE iom            ! nemo I/O library  
     27   USE iom            ! nemo I/O library 
    2828   USE ioipsl         ! I/O IPSL library 
    2929   USE in_out_manager ! I/O Manager 
    … …  
    3636   PUBLIC   mpp_basesplit  ! called by prtctl 
    3737   PUBLIC   mpp_is_ocean   ! called by prtctl 
    38     
     38 
    3939   INTEGER ::   numbot = -1   ! 'bottom_level' local logical unit 
    4040   INTEGER ::   numbdy = -1   ! 'bdy_msk'      local logical unit 
    41     
     41 
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    44    !! $Id$  
     44   !! $Id$ 
    4545   !! Software governed by the CeCILL license (see ./LICENSE) 
    4646   !!---------------------------------------------------------------------- 
    … …  
    8888      l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7) 
    8989      ! 
    90       CALL init_doloop                       ! set start/end indices or do-loop depending on the halo width value (nn_hls)  
     90      CALL init_doloop                       ! set start/end indices or do-loop depending on the halo width value (nn_hls) 
    9191      ! 
    9292      IF(lwp) THEN 
    … …  
    9494         WRITE(numout,*) 'mpp_init : NO massively parallel processing' 
    9595         WRITE(numout,*) '~~~~~~~~ ' 
    96          WRITE(numout,*) '   l_Iperio = ', l_Iperio, '    l_Jperio = ', l_Jperio  
     96         WRITE(numout,*) '   l_Iperio = ', l_Iperio, '    l_Jperio = ', l_Jperio 
    9797         WRITE(numout,*) '     npolj  = ',   npolj , '      njmpp  = ', njmpp 
    9898      ENDIF 
    … …  
    114114      !!---------------------------------------------------------------------- 
    115115      !!                  ***  ROUTINE mpp_init  *** 
    116       !!                     
     116      !! 
    117117      !! ** Purpose :   Lay out the global domain over processors. 
    118118      !!      If land processors are to be eliminated, this program requires the 
    … …  
    128128      !! 
    129129      !! ** Action : - set domain parameters 
    130       !!                    nimpp     : longitudinal index  
     130      !!                    nimpp     : longitudinal index 
    131131      !!                    njmpp     : latitudinal  index 
    132132      !!                    narea     : number for local area 
    … …  
    148148      INTEGER ::   iiea, ijea, iiwe, ijwe     !   -       - 
    149149      INTEGER ::   iarea0                     !   -       - 
    150       INTEGER ::   ierr, ios                  !  
     150      INTEGER ::   ierr, ios                  ! 
    151151      INTEGER ::   inbi, inbj, iimax,  ijmax, icnt1, icnt2 
    152152      LOGICAL ::   llbest, llauto 
    … …  
    162162      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,           & 
    163163           &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     & 
    164            &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &   
     164           &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             & 
    165165           &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 
    166166           &             cn_ice, nn_ice_dta,                                     & 
    … …  
    177177901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nammpp in reference namelist' ) 
    178178      READ  ( numnam_cfg, nammpp, IOSTAT = ios, ERR = 902 ) 
    179 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist' )    
     179902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist' ) 
    180180      ! 
    181181      nn_hls = MAX(1, nn_hls)   ! nn_hls must be > 0 
    … …  
    259259         ENDIF 
    260260      ENDIF 
    261        
     261 
    262262      ! look for land mpi subdomains... 
    263263      ALLOCATE( llisoce(jpni,jpnj) ) 
    … …  
    333333      CALL mpp_sum( 'mppini', ierr ) 
    334334      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' ) 
    335        
     335 
    336336#if defined key_agrif 
    337337      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
    … …  
    354354      !   nfjpi (jn) =   ijpi(ii,ij) 
    355355      !END DO 
    356       nfproc(:) = ipproc(:,jpnj)  
    357       nfimpp(:) = iimppt(:,jpnj)  
     356      nfproc(:) = ipproc(:,jpnj) 
     357      nfimpp(:) = iimppt(:,jpnj) 
    358358      nfjpi (:) =   ijpi(:,jpnj) 
    359359      ! 
    … …  
    363363         WRITE(numout,*) 
    364364         WRITE(numout,*) '   defines mpp subdomains' 
    365          WRITE(numout,*) '      jpni = ', jpni   
     365         WRITE(numout,*) '      jpni = ', jpni 
    366366         WRITE(numout,*) '      jpnj = ', jpnj 
    367367         WRITE(numout,*) '     jpnij = ', jpnij 
    … …  
    370370         WRITE(numout,*) '      sum ijpj(1,j) = ', sum(ijpj(1,:)), ' jpjglo = ', jpjglo 
    371371      ENDIF 
    372       
     372 
    373373      ! 3. Subdomain description in the Regular Case 
    374374      ! -------------------------------------------- 
    375375      ! specific cases where there is no communication -> must do the periodicity by itself 
    376       ! Warning: because of potential land-area suppression, do not use nbond[ij] == 2   
     376      ! Warning: because of potential land-area suppression, do not use nbond[ij] == 2 
    377377      l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7) 
    378378      l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7) 
    379        
     379 
    380380      DO jarea = 1, jpni*jpnj 
    381381         ! 
    … …  
    450450            ! In case of north fold exchange: I am the n neigbour of my n neigbour!! (#1057) 
    451451            ! --> for northern neighbours of northern row processors (in case of north-fold) 
    452             !     need to reverse the LOGICAL direction of communication  
     452            !     need to reverse the LOGICAL direction of communication 
    453453            idir = 1                                           ! we are indeed the s neigbour of this n neigbour 
    454454            IF( ij == jpnj .AND. ijno == jpnj )   idir = -1    ! both are on the last row, we are in fact the n neigbour 
    … …  
    478478         ENDIF 
    479479      END DO 
    480        
     480 
    481481      ! 5. Subdomain print 
    482482      ! ------------------ 
    … …  
    504504 9404    FORMAT('           *  '   ,20('     ' ,i4,'   *   ') ) 
    505505      ENDIF 
    506           
     506 
    507507      ! just to save nono etc for all proc 
    508508      ! warning ii*ij (zone) /= nproc (processors)! 
    … …  
    511511      ii_nono(:) = -1 
    512512      ii_noea(:) = -1 
    513       ii_nowe(:) = -1  
     513      ii_nowe(:) = -1 
    514514      DO jproc = 1, jpnij 
    515515         ii = iin(jproc) 
    … …  
    536536         ENDIF 
    537537      END DO 
    538      
     538 
    539539      ! 6. Change processor name 
    540540      ! ------------------------ 
    … …  
    542542      ij = ijn(narea) 
    543543      ! 
    544       jpi    = ijpi(ii,ij)   
     544      jpi    = ijpi(ii,ij) 
    545545!!$      Nis0  = iis0(ii,ij) 
    546546!!$      Nie0  = iie0(ii,ij) 
    547       jpj    = ijpj(ii,ij)   
     547      jpj    = ijpj(ii,ij) 
    548548!!$      Njs0  = ijs0(ii,ij) 
    549549!!$      Nje0  = ije0(ii,ij) 
    550550      nbondi = ibondi(ii,ij) 
    551551      nbondj = ibondj(ii,ij) 
    552       nimpp = iimppt(ii,ij)   
     552      nimpp = iimppt(ii,ij) 
    553553      njmpp = ijmppt(ii,ij) 
    554554      jpk = jpkglo                              ! third dim 
    … …  
    564564      noses = -1 
    565565      nosws = -1 
    566        
     566 
    567567      noner = -1 
    568568      nonwr = -1 
    … …  
    613613 
    614614      ! 
    615       CALL init_doloop                          ! set start/end indices of do-loop, depending on the halo width value (nn_hls)  
     615      CALL init_doloop                          ! set start/end indices of do-loop, depending on the halo width value (nn_hls) 
    616616      ! 
    617617      jpim1 = jpi-1                             ! inner domain indices 
    … …  
    630630         ibonit(jproc) = ibondi(ii,ij) 
    631631         ibonjt(jproc) = ibondj(ii,ij) 
    632          nimppt(jproc) = iimppt(ii,ij)   
    633          njmppt(jproc) = ijmppt(ii,ij)  
     632         nimppt(jproc) = iimppt(ii,ij) 
     633         njmppt(jproc) = ijmppt(ii,ij) 
    634634      END DO 
    635635 
    … …  
    647647               &                                nis0all(jproc), njs0all(jproc),   & 
    648648               &                                nie0all(jproc), nje0all(jproc),   & 
    649                &                                nimppt (jproc), njmppt (jproc),   &  
     649               &                                nimppt (jproc), njmppt (jproc),   & 
    650650               &                                ii_nono(jproc), ii_noso(jproc),   & 
    651651               &                                ii_nowe(jproc), ii_noea(jproc),   & 
    652                &                                ibonit (jproc), ibonjt (jproc)  
     652               &                                ibonit (jproc), ibonjt (jproc) 
    653653         END DO 
    654654      END IF 
    … …  
    707707      ! 
    708708      CALL init_ioipsl       ! Prepare NetCDF output file (if necessary) 
    709       !       
     709      ! 
    710710      IF (( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ).AND.( ln_nnogather )) THEN 
    711711         CALL init_nfdcom     ! northfold neighbour lists 
    … …  
    719719      ENDIF 
    720720      ! 
    721       IF (llwrtlay) CLOSE(inum)    
     721      IF (llwrtlay) CLOSE(inum) 
    722722      ! 
    723723      DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe,    & 
    … …  
    733733      !!---------------------------------------------------------------------- 
    734734      !!                  ***  ROUTINE mpp_basesplit  *** 
    735       !!                     
     735      !! 
    736736      !! ** Purpose :   Lay out the global domain over processors. 
    737737      !! 
    … …  
    752752      ! 
    753753      INTEGER ::   ji, jj 
    754       INTEGER ::   i2hls  
     754      INTEGER ::   i2hls 
    755755      INTEGER ::   iresti, irestj, irm, ijpjmin 
    756756      !!---------------------------------------------------------------------- 
    … …  
    759759#if defined key_nemocice_decomp 
    760760      kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim. 
    761       kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls    ! second dim.  
     761      kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls    ! second dim. 
    762762#else 
    763763      kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim. 
    … …  
    797797         irm = knbj - irestj                                       ! total number of lines to be removed 
    798798         klcj(:,knbj) = MAX( ijpjmin, kjmax-irm )                  ! we must have jpj >= ijpjmin in the last row 
    799          irm = irm - ( kjmax - klcj(1,knbj) )                      ! remaining number of lines to remove  
     799         irm = irm - ( kjmax - klcj(1,knbj) )                      ! remaining number of lines to remove 
    800800         irestj = knbj - 1 - irm 
    801801         klcj(:, irestj+1:knbj-1) = kjmax-1 
    … …  
    831831         END DO 
    832832      ENDIF 
    833        
     833 
    834834   END SUBROUTINE mpp_basesplit 
    835835 
    … …  
    890890      ! get the list of knbi that gives a smaller jpimax than knbi-1 
    891891      ! get the list of knbj that gives a smaller jpjmax than knbj-1 
    892       DO ji = 1, inbijmax       
     892      DO ji = 1, inbijmax 
    893893#if defined key_nemocice_decomp 
    894894         iszitst = ( nx_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls    ! first  dim. 
    … …  
    958958      ! extract only the partitions which reduce the subdomain size in comparison with smaller partitions 
    959959      ALLOCATE( indexok(isz1) )                                 ! to store indices of the best partitions 
    960       isz0 = 0                                                  ! number of best partitions      
     960      isz0 = 0                                                  ! number of best partitions 
    961961      inbij = 1                                                 ! start with the min value of inbij1 => 1 
    962962      iszij = jpiglo*jpjglo+1                                   ! default: larger than global domain 
    … …  
    10181018         CALL mppstop( ld_abort = .TRUE. ) 
    10191019      ENDIF 
    1020        
     1020 
    10211021      DEALLOCATE( iszi0, iszj0 ) 
    10221022      inbij = inbijmax + 1        ! default: larger than possible 
    10231023      ii = isz0+1                 ! start from the end of the list (smaller subdomains) 
    10241024      DO WHILE( inbij > knbij )   ! while the number of ocean subdomains exceed the number of procs 
    1025          ii = ii -1  
     1025         ii = ii -1 
    10261026         ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) ) 
    10271027         CALL mpp_is_ocean( llisoce )            ! must be done by all core 
    … …  
    10351035      ! 
    10361036   END SUBROUTINE bestpartition 
    1037     
    1038     
     1037 
     1038 
    10391039   SUBROUTINE mpp_init_landprop( propland ) 
    10401040      !!---------------------------------------------------------------------- 
    … …  
    10591059      ENDIF 
    10601060 
    1061       ! number of processes reading the bathymetry file  
     1061      ! number of processes reading the bathymetry file 
    10621062      iproc = MINVAL( (/mppsize, Nj0glo/2, 100/) )  ! read a least 2 lines, no more that 100 processes reading at the same time 
    1063        
     1063 
    10641064      ! we want to read iproc strips of the land-sea mask. -> pick up iproc processes every idiv processes starting at 1 
    10651065      IF( iproc == 1 ) THEN   ;   idiv = mppsize 
    … …  
    10841084      CALL mpp_sum( 'mppini', inboce )   ! total number of ocean points over the global domain 
    10851085      ! 
    1086       propland = REAL( Ni0glo*Nj0glo - inboce, wp ) / REAL( Ni0glo*Nj0glo, wp )  
     1086      propland = REAL( Ni0glo*Nj0glo - inboce, wp ) / REAL( Ni0glo*Nj0glo, wp ) 
    10871087      ! 
    10881088   END SUBROUTINE mpp_init_landprop 
    1089     
    1090     
     1089 
     1090 
    10911091   SUBROUTINE mpp_is_ocean( ldisoce ) 
    10921092      !!---------------------------------------------------------------------- 
    … …  
    11041104      !! ** Method  : read inbj strips (of length Ni0glo) of the land-sea mask 
    11051105      !!---------------------------------------------------------------------- 
    1106       LOGICAL, DIMENSION(:,:), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point  
     1106      LOGICAL, DIMENSION(:,:), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point 
    11071107      ! 
    11081108      INTEGER :: idiv, iimax, ijmax, iarea 
    … …  
    11131113      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ijpi 
    11141114      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ijpj 
    1115       LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce            ! lloce(i,j) = .true. if the point (i,j) is ocean  
     1115      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce            ! lloce(i,j) = .true. if the point (i,j) is ocean 
    11161116      !!---------------------------------------------------------------------- 
    11171117      ! do nothing if there is no land-sea mask 
    … …  
    11461146            isty = 1 + COUNT( (/ iarea == 1 /) )                       ! read from the first or the second line? 
    11471147            CALL readbot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) )   ! read the strip 
    1148             !  
     1148            ! 
    11491149            IF( iarea == 1    ) THEN                                   ! the first line was not read 
    11501150               IF( jperio == 2 .OR. jperio == 7 ) THEN                 !   north-south periodocity 
    … …  
    11571157               IF( jperio == 2 .OR. jperio == 7 ) THEN                 !   north-south periodocity 
    11581158                  CALL readbot_strip( 1, 1, lloce(2:inx-1,iny) )       !      read the first line -> last line of lloce 
    1159                ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN             !   north-pole folding T-pivot, T-point  
     1159               ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN             !   north-pole folding T-pivot, T-point 
    11601160                  lloce(2,iny) = lloce(2,iny-2)                        !      here we have 1 halo (even if nn_hls>1) 
    11611161                  DO ji = 3,inx-1 
    … …  
    11911191         ENDIF 
    11921192      END DO 
    1193     
     1193 
    11941194      inboce_1d = RESHAPE(inboce, (/ inbi*inbj /)) 
    11951195      CALL mpp_sum( 'mppini', inboce_1d ) 
    … …  
    11991199      ! 
    12001200   END SUBROUTINE mpp_is_ocean 
    1201     
    1202     
     1201 
     1202 
    12031203   SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce ) 
    12041204      !!---------------------------------------------------------------------- 
    … …  
    12131213      INTEGER                         , INTENT(in   ) ::   kjstr       ! starting j position of the reading 
    12141214      INTEGER                         , INTENT(in   ) ::   kjcnt       ! number of lines to read 
    1215       LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT(  out) ::   ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean  
     1215      LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT(  out) ::   ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean 
    12161216      ! 
    12171217      INTEGER                           ::   inumsave                ! local logical unit 
    1218       REAL(wp), DIMENSION(Ni0glo,kjcnt) ::   zbot, zbdy  
     1218      REAL(wp), DIMENSION(Ni0glo,kjcnt) ::   zbot, zbdy 
    12191219      !!---------------------------------------------------------------------- 
    12201220      ! 
    12211221      inumsave = numout   ;   numout = numnul   !   redirect all print to /dev/null 
    12221222      ! 
    1223       IF( numbot /= -1 ) THEN    
     1223      IF( numbot /= -1 ) THEN 
    12241224         CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 
    12251225      ELSE 
    … …  
    12271227      ENDIF 
    12281228      ! 
    1229       IF( numbdy /= -1 ) THEN                   ! Adjust with bdy_msk if it exists     
     1229      IF( numbdy /= -1 ) THEN                   ! Adjust with bdy_msk if it exists 
    12301230         CALL iom_get ( numbdy, jpdom_unknown,     'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 
    12311231         zbot(:,:) = zbot(:,:) * zbdy(:,:) 
    … …  
    12951295      !!                  ***  ROUTINE init_ioipsl  *** 
    12961296      !! 
    1297       !! ** Purpose :    
    1298       !! 
    1299       !! ** Method  :    
     1297      !! ** Purpose : 
     1298      !! 
     1299      !! ** Method  : 
    13001300      !! 
    13011301      !! History : 
    1302       !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL  
     1302      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL 
    13031303      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij 
    13041304      !!---------------------------------------------------------------------- 
    … …  
    13281328      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 
    13291329      ! 
    1330    END SUBROUTINE init_ioipsl   
     1330   END SUBROUTINE init_ioipsl 
    13311331 
    13321332 
    … …  
    13341334      !!---------------------------------------------------------------------- 
    13351335      !!                     ***  ROUTINE  init_nfdcom  *** 
    1336       !! ** Purpose :   Setup for north fold exchanges with explicit  
     1336      !! ** Purpose :   Setup for north fold exchanges with explicit 
    13371337      !!                point-to-point messaging 
    13381338      !! 
    … …  
    13401340      !!---------------------------------------------------------------------- 
    13411341      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    1342       !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
     1342      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
    13431343      !!---------------------------------------------------------------------- 
    13441344      INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    … …  
    13921392      ! 
    13931393      Nis0 =   1+nn_hls   ;   Nis1 = Nis0-1   ;   Nis2 = MAX(  1, Nis0-2) 
    1394       Njs0 =   1+nn_hls   ;   Njs1 = Njs0-1   ;   Njs2 = MAX(  1, Njs0-2)   
    1395       !                                                  
     1394      Njs0 =   1+nn_hls   ;   Njs1 = Njs0-1   ;   Njs2 = MAX(  1, Njs0-2) 
     1395      ! 
    13961396      Nie0 = jpi-nn_hls   ;   Nie1 = Nie0+1   ;   Nie2 = MIN(jpi, Nie0+2) 
    13971397      Nje0 = jpj-nn_hls   ;   Nje1 = Nje0+1   ;   Nje2 = MIN(jpj, Nje0+2) 
    … …  
    14021402         Nie1nxt2 = Nie0   ;   Nje1nxt2 = Nje0 
    14031403         ! 
    1404       ELSE                            !* larger halo size...  
     1404      ELSE                            !* larger halo size... 
    14051405         ! 
    14061406         Nis1nxt2 = Nis1   ;   Njs1nxt2 = Njs1 
    … …  
    14171417      ! 
    14181418   END SUBROUTINE init_doloop 
    1419     
     1419 
    14201420   !!====================================================================== 
    14211421END MODULE mppini 

  • NEMO/trunk/src/OCE/LDF/ldfc1d_c2d.F90

    r13982 r14072  
    22   !!====================================================================== 
    33   !!                    ***  MODULE  ldfc1d_c2d  *** 
    4    !! Ocean physics:  profile and horizontal shape of lateral eddy coefficients  
     4   !! Ocean physics:  profile and horizontal shape of lateral eddy coefficients 
    55   !!===================================================================== 
    66   !! History :  3.7  ! 2013-12  (G. Madec)  restructuration/simplification of aht/aeiv specification, 
    … …  
    99 
    1010   !!---------------------------------------------------------------------- 
    11    !!   ldf_c1d       : ah reduced by 1/4 on the vertical (tanh profile, inflection at 300m)  
     11   !!   ldf_c1d       : ah reduced by 1/4 on the vertical (tanh profile, inflection at 300m) 
    1212   !!   ldf_c2d       : ah = F(e1,e2) (laplacian or = F(e1^3,e2^3) (bilaplacian) 
    1313   !!---------------------------------------------------------------------- 
    … …  
    2929   REAL(wp) ::   r1_4  = 0.25_wp          ! =1/4 
    3030   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! =1/12 
    31   
     31 
    3232   !! * Substitutions 
    3333#  include "do_loop_substitute.h90" 
    … …  
    4242      !!---------------------------------------------------------------------- 
    4343      !!                  ***  ROUTINE ldf_c1d  *** 
    44       !!               
     44      !! 
    4545      !! ** Purpose :   1D eddy diffusivity/viscosity coefficients 
    4646      !! 
    4747      !! ** Method  :   1D eddy diffusivity coefficients F( depth ) 
    48       !!                Reduction by zratio from surface to bottom  
    49       !!                hyperbolic tangent profile with inflection point  
     48      !!                Reduction by zratio from surface to bottom 
     49      !!                hyperbolic tangent profile with inflection point 
    5050      !!                at zh=500m and a width of zw=200m 
    5151      !! 
    … …  
    9595         END_3D 
    9696         ! Lateral boundary conditions 
    97          CALL lbc_lnk_multi( 'ldfc1d_c2d', pah1, 'U', 1.0_wp , pah2, 'V', 1.0_wp )    
     97         CALL lbc_lnk_multi( 'ldfc1d_c2d', pah1, 'U', 1.0_wp , pah2, 'V', 1.0_wp ) 
    9898         ! 
    9999      CASE DEFAULT                        ! error 
    … …  
    107107      !!---------------------------------------------------------------------- 
    108108      !!                  ***  ROUTINE ldf_c2d  *** 
    109       !!               
     109      !! 
    110110      !! ** Purpose :   2D eddy diffusivity/viscosity coefficients 
    111111      !! 
    … …  
    113113      !!       laplacian   operator :   ah proportional to the scale factor      [m2/s] 
    114114      !!       bilaplacian operator :   ah proportional to the (scale factor)^3  [m4/s] 
    115       !!       In both cases, pah0 is the maximum value reached by the coefficient  
     115      !!       In both cases, pah0 is the maximum value reached by the coefficient 
    116116      !!       at the Equator in case of e1=ra*rad= ~111km, not over the whole domain. 
    117117      !! 

  • NEMO/trunk/src/OCE/LDF/ldftra.F90

    r13982 r14072  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  ldftra  *** 
    4    !! Ocean physics:  lateral diffusivity coefficients  
     4   !! Ocean physics:  lateral diffusivity coefficients 
    55   !!===================================================================== 
    66   !! History :       ! 1997-07  (G. Madec)  from inimix.F split in 2 routines 
    77   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module 
    8    !!            2.0  ! 2005-11  (G. Madec)   
     8   !!            2.0  ! 2005-11  (G. Madec) 
    99   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  restructuration/simplification of aht/aeiv specification, 
    1010   !!                 !                                  add velocity dependent coefficient and optional read in file 
    … …  
    1313   !!---------------------------------------------------------------------- 
    1414   !!   ldf_tra_init : initialization, namelist read, and parameters control 
    15    !!   ldf_tra      : update lateral eddy diffusivity coefficients at each time step  
    16    !!   ldf_eiv_init : initialization of the eiv coeff. from namelist choices  
     15   !!   ldf_tra      : update lateral eddy diffusivity coefficients at each time step 
     16   !!   ldf_eiv_init : initialization of the eiv coeff. from namelist choices 
    1717   !!   ldf_eiv      : time evolution of the eiv coefficients (function of the growth rate of baroclinic instability) 
    1818   !!   ldf_eiv_trp  : add to the input ocean transport the contribution of the EIV parametrization 
    … …  
    2323   USE phycst          ! physical constants 
    2424   USE ldfslp          ! lateral diffusion: slope of iso-neutral surfaces 
    25    USE ldfc1d_c2d      ! lateral diffusion: 1D & 2D cases  
     25   USE ldfc1d_c2d      ! lateral diffusion: 1D & 2D cases 
    2626   USE diaptr 
    2727   ! 
    … …  
    4040   PUBLIC   ldf_eiv_trp    ! called by traadv.F90 
    4141   PUBLIC   ldf_eiv_dia    ! called by traldf_iso and traldf_iso_triad.F90 
    42     
    43    !                                   !!* Namelist namtra_ldf : lateral mixing on tracers *  
     42 
     43   !                                   !!* Namelist namtra_ldf : lateral mixing on tracers * 
    4444   !                                    != Operator type =! 
    4545   LOGICAL , PUBLIC ::   ln_traldf_OFF       !: no operator: No explicit diffusion 
    … …  
    5252   !                                    != iso-neutral options =! 
    5353!  LOGICAL , PUBLIC ::   ln_traldf_triad     !: griffies triad scheme                    (see ldfslp) 
    54    LOGICAL , PUBLIC ::   ln_traldf_msc       !: Method of Stabilizing Correction  
     54   LOGICAL , PUBLIC ::   ln_traldf_msc       !: Method of Stabilizing Correction 
    5555!  LOGICAL , PUBLIC ::   ln_triad_iso        !: pure horizontal mixing in ML             (see ldfslp) 
    5656!  LOGICAL , PUBLIC ::   ln_botmix_triad     !: mixing on bottom                         (see ldfslp) 
    … …  
    5959   !                                    !=  Coefficients =! 
    6060   INTEGER , PUBLIC ::   nn_aht_ijk_t        !: choice of time & space variations of the lateral eddy diffusivity coef. 
    61    !                                            !  time invariant coefficients:  aht_0 = 1/2  Ud*Ld   (lap case)  
     61   !                                            !  time invariant coefficients:  aht_0 = 1/2  Ud*Ld   (lap case) 
    6262   !                                            !                                bht_0 = 1/12 Ud*Ld^3 (blp case) 
    6363   REAL(wp), PUBLIC ::      rn_Ud               !: lateral diffusive velocity  [m/s] 
    … …  
    7272   REAL(wp), PUBLIC ::      rn_Ue               !: lateral diffusive velocity  [m/s] 
    7373   REAL(wp), PUBLIC ::      rn_Le               !: lateral diffusive length    [m] 
    74     
     74 
    7575   !                                  ! Flag to control the type of lateral diffusive operator 
    7676   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   ! error in specification of lateral diffusion 
    … …  
    106106      !!---------------------------------------------------------------------- 
    107107      !!                  ***  ROUTINE ldf_tra_init  *** 
    108       !!  
     108      !! 
    109109      !! ** Purpose :   initializations of the tracer lateral mixing coeff. 
    110110      !! 
    … …  
    116116      !!    nn_aht_ijk_t  =  0 => = constant 
    117117      !!                  ! 
    118       !!                  = 10 => = F(z) : constant with a reduction of 1/4 with depth  
     118      !!                  = 10 => = F(z) : constant with a reduction of 1/4 with depth 
    119119      !!                  ! 
    120120      !!                  =-20 => = F(i,j)   = shape read in 'eddy_diffusivity.nc' file 
    … …  
    126126      !!                  = 31    = F(i,j,k,t) = F(local velocity) (  1/2  |u|e     laplacian operator 
    127127      !!                                                           or 1/12 |u|e^3 bilaplacian operator ) 
    128       !!              * initialisation of the eddy induced velocity coefficient by a call to ldf_eiv_init  
    129       !!             
     128      !!              * initialisation of the eddy induced velocity coefficient by a call to ldf_eiv_init 
     129      !! 
    130130      !! ** action  : ahtu, ahtv initialized one for all or l_ldftra_time set to true 
    131131      !!              aeiu, aeiv initialized one for all or l_ldfeiv_time set to true 
    … …  
    148148         WRITE(numout,*) '~~~~~~~~~~~~ ' 
    149149      ENDIF 
    150        
     150 
    151151      ! 
    152152      !  Choice of lateral tracer physics 
    … …  
    182182      ! 
    183183      ! 
    184       ! Operator and its acting direction   (set nldf_tra)   
     184      ! Operator and its acting direction   (set nldf_tra) 
    185185      ! ================================= 
    186186      ! 
    … …  
    210210            ENDIF 
    211211            IF ( ln_zps ) THEN                  ! z-coordinate with partial step 
    212                IF ( ln_traldf_lev   )   ierr     = 1          ! iso-level not allowed  
     212               IF ( ln_traldf_lev   )   ierr     = 1          ! iso-level not allowed 
    213213               IF ( ln_traldf_hor   )   nldf_tra = np_lap     ! horizontal             (no rotation) 
    214214               IF ( ln_traldf_iso   )   nldf_tra = np_lap_i   ! iso-neutral: standard     (rotation) 
    … …  
    231231            ENDIF 
    232232            IF ( ln_zps ) THEN                  ! z-coordinate with partial step 
    233                IF ( ln_traldf_lev   )   ierr     = 1          ! iso-level not allowed  
     233               IF ( ln_traldf_lev   )   ierr     = 1          ! iso-level not allowed 
    234234               IF ( ln_traldf_hor   )   nldf_tra = np_blp     ! horizontal             (no rotation) 
    235235               IF ( ln_traldf_iso   )   nldf_tra = np_blp_i   ! iso-neutral: standard  (   rotation) 
    … …  
    249249           ! 
    250250      IF(  nldf_tra == np_lap_i .OR. nldf_tra == np_lap_it .OR. & 
    251          & nldf_tra == np_blp_i .OR. nldf_tra == np_blp_it  )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required  
     251         & nldf_tra == np_blp_i .OR. nldf_tra == np_blp_it  )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required 
    252252      ! 
    253253      IF( ln_traldf_blp .AND. ( ln_traldf_iso .OR. ln_traldf_triad) ) THEN     ! iso-neutral bilaplacian need MSC 
    … …  
    270270 
    271271      ! 
    272       !  Space/time variation of eddy coefficients  
     272      !  Space/time variation of eddy coefficients 
    273273      ! =========================================== 
    274274      ! 
    … …  
    286286         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays') 
    287287         ! 
    288          ahtu(:,:,jpk) = 0._wp                     ! last level always 0   
     288         ahtu(:,:,jpk) = 0._wp                     ! last level always 0 
    289289         ahtv(:,:,jpk) = 0._wp 
    290290         !. 
    … …  
    363363         END SELECT 
    364364         ! 
    365          IF( .NOT.l_ldftra_time ) THEN             !* No time variation  
     365         IF( .NOT.l_ldftra_time ) THEN             !* No time variation 
    366366            IF(     ln_traldf_lap ) THEN                 !   laplacian operator (mask only) 
    367367               ahtu(:,:,1:jpkm1) =       ahtu(:,:,1:jpkm1)   * umask(:,:,1:jpkm1) 
    … …  
    381381      !!---------------------------------------------------------------------- 
    382382      !!                  ***  ROUTINE ldf_tra  *** 
    383       !!  
     383      !! 
    384384      !! ** Purpose :   update at kt the tracer lateral mixing coeff. (aht and aeiv) 
    385385      !! 
    … …  
    395395      !!              * time varying EIV coefficients: call to ldf_eiv routine 
    396396      !! 
    397       !! ** action  :   ahtu, ahtv   update at each time step    
    398       !!                aeiu, aeiv      -       -     -    -   (if ln_ldfeiv=T)  
     397      !! ** action  :   ahtu, ahtv   update at each time step 
     398      !!                aeiu, aeiv      -       -     -    -   (if ln_ldfeiv=T) 
    399399      !!---------------------------------------------------------------------- 
    400400      INTEGER, INTENT(in) ::   kt   ! time step 
    … …  
    420420            ahtu(:,:,1) = aeiu(:,:,1) 
    421421            ahtv(:,:,1) = aeiv(:,:,1) 
    422          ELSE                                            ! compute aht.  
     422         ELSE                                            ! compute aht. 
    423423            CALL ldf_eiv( kt, aht0, ahtu, ahtv, Kmm ) 
    424424         ENDIF 
    425425         ! 
    426          z1_f20   = 1._wp / (  2._wp * omega * SIN( rad * 20._wp )  )   ! 1 / ff(20 degrees)    
     426         z1_f20   = 1._wp / (  2._wp * omega * SIN( rad * 20._wp )  )   ! 1 / ff(20 degrees) 
    427427         zaht_min = 0.2_wp * aht0                                       ! minimum value for aht 
    428          zDaht    = aht0 - zaht_min                                       
     428         zDaht    = aht0 - zaht_min 
    429429         ! NOTE: [tiling-comms-merge] Change needed to preserve results with respect to the trunk 
    430430         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    … …  
    480480      !!    nn_aei_ijk_t  =  0 => = constant 
    481481      !!                  ! 
    482       !!                  = 10 => = F(z) : constant with a reduction of 1/4 with depth  
     482      !!                  = 10 => = F(z) : constant with a reduction of 1/4 with depth 
    483483      !!                  ! 
    484484      !!                  =-20 => = F(i,j)   = shape read in 'eddy_diffusivity.nc' file 
    … …  
    547547         !                                != Specification of space-time variations of eaiu, aeiv 
    548548         ! 
    549          aeiu(:,:,jpk) = 0._wp               ! last level always 0   
     549         aeiu(:,:,jpk) = 0._wp               ! last level always 0 
    550550         aeiv(:,:,jpk) = 0._wp 
    551551         !                                   ! value of EIV coef. (laplacian operator) 
    … …  
    609609         END SELECT 
    610610         ! 
    611          IF( .NOT.l_ldfeiv_time ) THEN             !* mask if No time variation  
     611         IF( .NOT.l_ldfeiv_time ) THEN             !* mask if No time variation 
    612612            DO jk = 1, jpkm1 
    613613               aeiu(:,:,jk) = aeiu(:,:,jk) * umask(:,:,jk) 
    … …  
    617617         ! 
    618618      ENDIF 
    619       !                     
     619      ! 
    620620   END SUBROUTINE ldf_eiv_init 
    621621 
    … …  
    649649      IF( ln_traldf_triad ) THEN 
    650650         DO_3D( 0, 0, 0, 0, 1, jpk ) 
    651             ! Take the max of N^2 and zero then take the vertical sum  
    652             ! of the square root of the resulting N^2 ( required to compute  
    653             ! internal Rossby radius Ro = .5 * sum_jpk(N) / f  
     651            ! Take the max of N^2 and zero then take the vertical sum 
     652            ! of the square root of the resulting N^2 ( required to compute 
     653            ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
    654654            zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 
    655655            zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w(ji,jj,jk,Kmm) 
    656656            ! Compute elements required for the inverse time scale of baroclinic 
    657             ! eddies using the isopycnal slopes calculated in ldfslp.F :  
     657            ! eddies using the isopycnal slopes calculated in ldfslp.F : 
    658658            ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
    659659            ze3w = e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 
    … …  
    663663      ELSE 
    664664         DO_3D( 0, 0, 0, 0, 1, jpk ) 
    665             ! Take the max of N^2 and zero then take the vertical sum  
    666             ! of the square root of the resulting N^2 ( required to compute  
    667             ! internal Rossby radius Ro = .5 * sum_jpk(N) / f  
     665            ! Take the max of N^2 and zero then take the vertical sum 
     666            ! of the square root of the resulting N^2 ( required to compute 
     667            ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
    668668            zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 
    669669            zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w(ji,jj,jk,Kmm) 
    670670            ! Compute elements required for the inverse time scale of baroclinic 
    671             ! eddies using the isopycnal slopes calculated in ldfslp.F :  
     671            ! eddies using the isopycnal slopes calculated in ldfslp.F : 
    672672            ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
    673673            ze3w = e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 
    … …  
    693693      END_2D 
    694694      CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp )       ! lateral boundary condition 
    695       !                
     695      ! 
    696696      DO_2D( 0, 0, 0, 0 )                       !== aei at u- and v-points  ==! 
    697697         paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1) 
    … …  
    704704         paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk) 
    705705      END DO 
    706       !   
     706      ! 
    707707   END SUBROUTINE ldf_eiv 
    708708 
    … …  
    711711      !!---------------------------------------------------------------------- 
    712712      !!                  ***  ROUTINE ldf_eiv_trp  *** 
    713       !!  
    714       !! ** Purpose :   add to the input ocean transport the contribution of  
     713      !! 
     714      !! ** Purpose :   add to the input ocean transport the contribution of 
    715715      !!              the eddy induced velocity parametrization. 
    716716      !! 
    717717      !! ** Method  :   The eddy induced transport is computed from a flux stream- 
    718718      !!              function which depends on the slope of iso-neutral surfaces 
    719       !!              (see ldf_slp). For example, in the i-k plan :  
     719      !!              (see ldf_slp). For example, in the i-k plan : 
    720720      !!                   psi_uw = mk(aeiu) e2u mi(wslpi)   [in m3/s] 
    721721      !!                   Utr_eiv = - dk[psi_uw] 
    … …  
    748748      ENDIF 
    749749 
    750        
     750 
    751751      zpsi_uw(:,:, 1 ) = 0._wp   ;   zpsi_vw(:,:, 1 ) = 0._wp 
    752752      zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp 
    … …  
    794794      ! 
    795795!!gm I don't like this routine....   Crazy  way of doing things, not optimal at all... 
    796 !!gm     to be redesigned....    
     796!!gm     to be redesigned.... 
    797797      !                                                  !==  eiv stream function: output  ==! 
    798798!!gm      CALL iom_put( "psi_eiv_uw", psi_uw )                 ! output 
    … …  
    826826            zw3d(:,:,jk) = zw3d(:,:,jk) * zw2d(:,:) 
    827827         END DO 
    828          CALL iom_put( "weiv_masstr" , zw3d )   
     828         CALL iom_put( "weiv_masstr" , zw3d ) 
    829829      ENDIF 
    830830      ! 
    … …  
    832832         zw3d(:,:,:) = 0.e0 
    833833         DO jk = 1, jpkm1 
    834             zw3d(:,:,jk) = rho0 * ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) )  
     834            zw3d(:,:,jk) = rho0 * ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) 
    835835         END DO 
    836836         CALL iom_put( "ueiv_masstr", zw3d )                  ! mass transport in i-direction 
    837837      ENDIF 
    838838      ! 
    839       zztmp = 0.5_wp * rho0 * rcp  
     839      zztmp = 0.5_wp * rho0 * rcp 
    840840      IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 
    841         zw2d(:,:)   = 0._wp  
    842         zw3d(:,:,:) = 0._wp  
     841        zw2d(:,:)   = 0._wp 
     842        zw3d(:,:,:) = 0._wp 
    843843        DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    844844           zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)          - psi_uw(ji  ,jj,jk)            )   & 
    845               &                            * ( ts    (ji,jj,jk,jp_tem,Kmm) + ts    (ji+1,jj,jk,jp_tem,Kmm) )  
     845              &                            * ( ts    (ji,jj,jk,jp_tem,Kmm) + ts    (ji+1,jj,jk,jp_tem,Kmm) ) 
    846846           zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    847847        END_3D 
    … …  
    853853         zw3d(:,:,:) = 0.e0 
    854854         DO jk = 1, jpkm1 
    855             zw3d(:,:,jk) = rho0 * ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) )  
     855            zw3d(:,:,jk) = rho0 * ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) 
    856856         END DO 
    857857         CALL iom_put( "veiv_masstr", zw3d )                  ! mass transport in i-direction 
    858858      ENDIF 
    859859      ! 
    860       zw2d(:,:)   = 0._wp  
    861       zw3d(:,:,:) = 0._wp  
     860      zw2d(:,:)   = 0._wp 
     861      zw3d(:,:,:) = 0._wp 
    862862      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    863863         zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)          - psi_vw(ji,jj  ,jk)            )   & 
    864             &                            * ( ts    (ji,jj,jk,jp_tem,Kmm) + ts    (ji,jj+1,jk,jp_tem,Kmm) )  
     864            &                            * ( ts    (ji,jj,jk,jp_tem,Kmm) + ts    (ji,jj+1,jk,jp_tem,Kmm) ) 
    865865         zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    866866      END_3D 
    … …  
    872872      zztmp = 0.5_wp * 0.5 
    873873      IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN 
    874         zw2d(:,:) = 0._wp  
    875         zw3d(:,:,:) = 0._wp  
     874        zw2d(:,:) = 0._wp 
     875        zw3d(:,:,:) = 0._wp 
    876876        DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    877877           zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)          - psi_uw(ji  ,jj,jk)            )   & 
    878               &                            * ( ts    (ji,jj,jk,jp_sal,Kmm) + ts    (ji+1,jj,jk,jp_sal,Kmm) )  
     878              &                            * ( ts    (ji,jj,jk,jp_sal,Kmm) + ts    (ji+1,jj,jk,jp_sal,Kmm) ) 
    879879           zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    880880        END_3D 
    … …  
    882882        CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                ! salt transport in i-direction 
    883883      ENDIF 
    884       zw2d(:,:) = 0._wp  
    885       zw3d(:,:,:) = 0._wp  
     884      zw2d(:,:) = 0._wp 
     885      zw3d(:,:,:) = 0._wp 
    886886      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    887887         zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)          - psi_vw(ji,jj  ,jk)            )   & 
    888             &                            * ( ts    (ji,jj,jk,jp_sal,Kmm) + ts    (ji,jj+1,jk,jp_sal,Kmm) )  
     888            &                            * ( ts    (ji,jj,jk,jp_sal,Kmm) + ts    (ji,jj+1,jk,jp_sal,Kmm) ) 
    889889         zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    890890      END_3D 

  • NEMO/trunk/src/OCE/SBC/cpl_oasis3.F90

    r14007 r14072  
    1414   !!            3.6  !  2014-11  (S. Masson) OASIS3-MCT 
    1515   !!---------------------------------------------------------------------- 
    16     
     16 
    1717   !!---------------------------------------------------------------------- 
    1818   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3-MCT 
    … …  
    6363#endif 
    6464 
    65    INTEGER                    ::   nrcv         ! total number of fields received  
    66    INTEGER                    ::   nsnd         ! total number of fields sent  
     65   INTEGER                    ::   nrcv         ! total number of fields received 
     66   INTEGER                    ::   nsnd         ! total number of fields sent 
    6767   INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    6868   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=62   ! Maximum number of coupling fields 
    6969   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
    7070   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 
    71     
     71 
    7272   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information 
    7373      LOGICAL               ::   laction   ! To be coupled or not 
    74       CHARACTER(len = 8)    ::   clname    ! Name of the coupling field    
    75       CHARACTER(len = 1)    ::   clgrid    ! Grid type   
     74      CHARACTER(len = 8)    ::   clname    ! Name of the coupling field 
     75      CHARACTER(len = 1)    ::   clgrid    ! Grid type 
    7676      REAL(wp)              ::   nsgn      ! Control of the sign change 
    7777      INTEGER, DIMENSION(nmaxcat,nmaxcpl) ::   nid   ! Id of the field (no more than 9 categories and 9 extrena models) 
    … …  
    9898      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software) 
    9999      !! 
    100       !! ** Method  :   OASIS3 MPI communication  
     100      !! ** Method  :   OASIS3 MPI communication 
    101101      !!-------------------------------------------------------------------- 
    102102      CHARACTER(len = *), INTENT(in   ) ::   cd_modname   ! model name as set in namcouple file 
    … …  
    132132      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software) 
    133133      !! 
    134       !! ** Method  :   OASIS3 MPI communication  
     134      !! ** Method  :   OASIS3 MPI communication 
    135135      !!-------------------------------------------------------------------- 
    136136      INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields 
    … …  
    180180      ! 
    181181      ! ----------------------------------------------------------------- 
    182       ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis     
     182      ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis 
    183183      ! ----------------------------------------------------------------- 
    184        
     184 
    185185      paral(1) = 2                                      ! box partitioning 
    186       paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls)   ! NEMO lower left corner global offset, without halos  
     186      paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls)   ! NEMO lower left corner global offset, without halos 
    187187      paral(3) = Ni_0                                   ! local extent in i, excluding halos 
    188188      paral(4) = Nj_0                                   ! local extent in j, excluding halos 
    189189      paral(5) = Ni0glo                                 ! global extent in x, excluding halos 
    190        
     190 
    191191      IF( sn_cfctl%l_oasout ) THEN 
    192192         WRITE(numout,*) ' multiexchg: paral (1:5)', paral 
    … …  
    195195         WRITE(numout,*) ' multiexchg: Njs0, Nje0, njmpp =', Njs0, Nje0, njmpp 
    196196      ENDIF 
    197     
     197 
    198198      CALL oasis_def_partition ( id_part, paral, nerror, Ni0glo*Nj0glo )   ! global number of points, excluding halos 
    199199      ! 
    200       ! ... Announce send variables.  
     200      ! ... Announce send variables. 
    201201      ! 
    202202      ssnd(:)%ncplmodel = kcplmodel 
    … …  
    210210               RETURN 
    211211            ENDIF 
    212              
     212 
    213213            DO jc = 1, ssnd(ji)%nct 
    214214               DO jm = 1, kcplmodel 
    … …  
    225225                  ENDIF 
    226226#if defined key_agrif 
    227                   IF( agrif_fixed() /= 0 ) THEN  
     227                  IF( agrif_fixed() /= 0 ) THEN 
    228228                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
    229229                  ENDIF 
    … …  
    243243      END DO 
    244244      ! 
    245       ! ... Announce received variables.  
     245      ! ... Announce received variables. 
    246246      ! 
    247247      srcv(:)%ncplmodel = kcplmodel 
    248248      ! 
    249249      DO ji = 1, krcv 
    250          IF( srcv(ji)%laction ) THEN  
    251              
     250         IF( srcv(ji)%laction ) THEN 
     251 
    252252            IF( srcv(ji)%nct > nmaxcat ) THEN 
    253253               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   & 
    … …  
    255255               RETURN 
    256256            ENDIF 
    257              
     257 
    258258            DO jc = 1, srcv(ji)%nct 
    259259               DO jm = 1, kcplmodel 
    260                    
     260 
    261261                  IF( srcv(ji)%nct .GT. 1 ) THEN 
    262262                     WRITE(cli2,'(i2.2)') jc 
    … …  
    270270                  ENDIF 
    271271#if defined key_agrif 
    272                   IF( agrif_fixed() /= 0 ) THEN  
     272                  IF( agrif_fixed() /= 0 ) THEN 
    273273                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
    274274                  ENDIF 
    … …  
    288288         ENDIF 
    289289      END DO 
    290        
     290 
    291291      !------------------------------------------------------------------ 
    292292      ! End of definition phase 
    293293      !------------------------------------------------------------------ 
    294       !      
     294      ! 
    295295#if defined key_agrif 
    296296      IF( agrif_fixed() == Agrif_Nb_Fine_Grids() ) THEN 
    … …  
    303303      ! 
    304304   END SUBROUTINE cpl_define 
    305     
    306     
     305 
     306 
    307307   SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 
    308308      !!--------------------------------------------------------------------- 
    … …  
    324324      DO jc = 1, ssnd(kid)%nct 
    325325         DO jm = 1, ssnd(kid)%ncplmodel 
    326          
     326 
    327327            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN   ! exclude halos from data sent to oasis 
    328328               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(Nis0:Nie0, Njs0:Nje0,jc), kinfo ) 
    329                 
    330                IF ( sn_cfctl%l_oasout ) THEN         
     329 
     330               IF ( sn_cfctl%l_oasout ) THEN 
    331331                  IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   & 
    332332                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN 
    … …  
    342342                  ENDIF 
    343343               ENDIF 
    344                 
     344 
    345345            ENDIF 
    346              
     346 
    347347         ENDDO 
    348348      ENDDO 
    … …  
    379379            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
    380380 
    381                CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )          
    382                 
     381               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 
     382 
    383383               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
    384384                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
    385                 
     385 
    386386               IF ( sn_cfctl%l_oasout )   & 
    387387                  &  WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
    388                 
     388 
    389389               IF( llaction ) THEN   ! data received from oasis do not include halos 
    390                    
     390 
    391391                  kinfo = OASIS_Rcv 
    392                   IF( ll_1st ) THEN  
     392                  IF( ll_1st ) THEN 
    393393                     pdata(Nis0:Nie0,Njs0:Nje0,jc) =   exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 
    394394                     ll_1st = .FALSE. 
    … …  
    397397                        &                                + exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 
    398398                  ENDIF 
    399                    
    400                   IF ( sn_cfctl%l_oasout ) THEN         
     399 
     400                  IF ( sn_cfctl%l_oasout ) THEN 
    401401                     WRITE(numout,*) '****************' 
    402402                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
    … …  
    409409                     WRITE(numout,*) '****************' 
    410410                  ENDIF 
    411                    
     411 
    412412               ENDIF 
    413                 
     413 
    414414            ENDIF 
    415              
     415 
    416416         ENDDO 
    417417 
    418418         !--- we must call lbc_lnk to fill the halos that where not received. 
    419419         IF( .NOT. ll_1st ) THEN 
    420             CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
     420            CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 
    421421         ENDIF 
    422   
     422 
    423423      ENDDO 
    424424      ! 
    … …  
    426426 
    427427 
    428    INTEGER FUNCTION cpl_freq( cdfieldname )   
     428   INTEGER FUNCTION cpl_freq( cdfieldname ) 
    429429      !!--------------------------------------------------------------------- 
    430430      !!              ***  ROUTINE cpl_freq  *** 
    … …  
    491491      DEALLOCATE( exfld ) 
    492492      IF(nstop == 0) THEN 
    493          CALL oasis_terminate( nerror )          
     493         CALL oasis_terminate( nerror ) 
    494494      ELSE 
    495495         CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 
    496       ENDIF        
     496      ENDIF 
    497497      ! 
    498498   END SUBROUTINE cpl_finalize 
    … …  
    544544      WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 
    545545   END SUBROUTINE oasis_enddef 
    546    
     546 
    547547   SUBROUTINE oasis_put(k1,k2,p1,k3) 
    548548      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::  p1 
    … …  
    574574      WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 
    575575   END SUBROUTINE oasis_terminate 
    576     
     576 
    577577#endif 
    578578 

  • NEMO/trunk/src/OCE/SBC/sbc_ice.F90

    r13472 r14072  
    2020# endif 
    2121# if defined key_cice 
    22    USE ice_domain_size, only: ncat  
     22   USE ice_domain_size, only: ncat 
    2323#endif 
    2424   USE lib_mpp          ! MPP library 
    … …  
    3232# if defined  key_si3 
    3333   LOGICAL         , PUBLIC, PARAMETER ::   lk_si3     = .TRUE.   !: SI3 ice model 
    34    LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  
     34   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE 
    3535# endif 
    3636# if defined  key_cice 
    … …  
    4747   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice        !: ice albedo                                       [-] 
    4848 
    49    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qml_ice        !: heat available for snow / ice surface melting     [W/m2]  
    50    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice        !: heat conduction flux in the layer below surface   [W/m2]  
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qml_ice        !: heat available for snow / ice surface melting     [W/m2] 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice        !: heat conduction flux in the layer below surface   [W/m2] 
    5151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_ice_top    !: solar flux transmitted below the ice surface      [W/m2] 
    5252 
    … …  
    8787   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iu              !: ice fraction at NEMO U point 
    8888   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iv              !: ice fraction at NEMO V point 
    89     
     89 
    9090   ! variables used in the coupled interface 
    9191   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat 
    92    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice  
    93     
     92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice 
     93 
    9494   ! already defined in ice.F90 for SI3 
    9595   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
    … …  
    9898   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
    9999#endif 
    100  
    101    REAL(wp), PUBLIC, SAVE ::   pp_cldf = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] 
    102100 
    103101   !! arrays relating to embedding ice in the ocean 
    … …  
    108106   !!---------------------------------------------------------------------- 
    109107   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    110    !! $Id$  
     108   !! $Id$ 
    111109   !! Software governed by the CeCILL license (see ./LICENSE) 
    112110   !!---------------------------------------------------------------------- 
    … …  
    145143         &                     v_ice(jpi,jpj)        , alb_ice(jpi,jpj,1)    , & 
    146144         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , & 
    147          &                     STAT= ierr(3) )       
     145         &                     STAT= ierr(3) ) 
    148146      IF( ln_cpl )   ALLOCATE( h_i(jpi,jpj,jpl) , h_s(jpi,jpj,jpl) , STAT=ierr(4) ) 
    149147#endif 
    … …  
    168166   LOGICAL         , PUBLIC, PARAMETER ::   lk_si3     = .FALSE.  !: no SI3 ice model 
    169167   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE ice model 
    170    REAL(wp)        , PUBLIC, PARAMETER ::   pp_cldf    = 0.81     !: cloud fraction over sea ice, summer CLIO value   [-] 
    171    INTEGER         , PUBLIC, PARAMETER ::   jpl = 1  
     168 
     169   INTEGER         , PUBLIC, PARAMETER ::   jpl = 1 
    172170   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice                        ! jpi, jpj 
    173171   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
    … …  
    178176   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt, botmelt 
    179177   ! 
    180    !! arrays related to embedding ice in the ocean.  
    181    !! These arrays need to be declared even if no ice model is required.  
     178   !! arrays related to embedding ice in the ocean. 
     179   !! These arrays need to be declared even if no ice model is required. 
    182180   !! In the no ice model or traditional levitating ice cases they contain only zeros 
    183181   !! --------------------- 

  • NEMO/trunk/src/OCE/SBC/sbc_oce.F90

    r14007 r14072  
    7373   LOGICAL , PUBLIC ::   ln_charn       !: =T Chranock coefficient from wave model 
    7474   LOGICAL , PUBLIC ::   ln_taw         !: =T wind stress corrected by wave intake 
    75    LOGICAL , PUBLIC ::   ln_phioc       !: =T TKE surface BC from wave model  
     75   LOGICAL , PUBLIC ::   ln_phioc       !: =T TKE surface BC from wave model 
    7676   LOGICAL , PUBLIC ::   ln_bern_srfc   !: Bernoulli head, waves' inuced pressure 
    7777   LOGICAL , PUBLIC ::   ln_breivikFV_2016 !: Breivik 2016 profile 
    … …  
    153153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 
    154154 
     155   !!---------------------------------------------------------------------- 
     156   !!                     Surface atmospheric fields 
     157   !!---------------------------------------------------------------------- 
     158   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_air_zt       !: specific humidity of air at z=zt [kg/kg]ww 
     159   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: theta_air_zt   !: potential temperature of air at z=zt [K] 
     160 
     161 
    155162   !! * Substitutions 
    156163#  include "do_loop_substitute.h90" 
    … …  
    166173      !!                  ***  FUNCTION sbc_oce_alloc  *** 
    167174      !!--------------------------------------------------------------------- 
    168       INTEGER :: ierr(5) 
     175      INTEGER :: ierr(6) 
    169176      !!--------------------------------------------------------------------- 
    170177      ierr(:) = 0 
    … …  
    188195      ! 
    189196      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) 
     197      ! 
     198      ALLOCATE( q_air_zt(jpi,jpj) , theta_air_zt(jpi,jpj) , STAT=ierr(6) ) !#LB 
    190199      ! 
    191200      sbc_oce_alloc = MAXVAL( ierr ) 

  • NEMO/trunk/src/OCE/SBC/sbcapr.F90

    r14053 r14072  
    66   !! History :  3.3  !   2010-09  (J. Chanut, C. Bricaud, G. Madec)  Original code 
    77   !!---------------------------------------------------------------------- 
    8     
     8 
    99   !!---------------------------------------------------------------------- 
    10    !!   sbc_apr        : read atmospheric pressure in netcdf files  
     10   !!   sbc_apr        : read atmospheric pressure in netcdf files 
    1111   !!---------------------------------------------------------------------- 
    1212   USE dom_oce         ! ocean space and time domain 
    … …  
    2525   PUBLIC   sbc_apr       ! routine called in sbcmod 
    2626   PUBLIC   sbc_apr_init  ! routine called in sbcmod 
    27     
     27 
    2828   !                                          !!* namsbc_apr namelist (Atmospheric PRessure) * 
    29    LOGICAL, PUBLIC ::   ln_apr_obc = .false.   !: inverse barometer added to OBC ssh data  
     29   LOGICAL, PUBLIC ::   ln_apr_obc = .false.   !: inverse barometer added to OBC ssh data 
    3030   LOGICAL, PUBLIC ::   ln_ref_apr             !: ref. pressure: global mean Patm (F) or a constant (F) 
    3131   REAL(wp)        ::   rn_pref                !  reference atmospheric pressure   [N/m2] 
    … …  
    3434   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ibb   ! Inverse barometer before sea surface height   [m] 
    3535   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   apr       ! atmospheric pressure at kt                 [N/m2] 
    36     
     36 
    3737   REAL(wp) ::   tarea                ! whole domain mean masked ocean surface 
    3838   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rho0) 
    39     
     39 
    4040   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read) 
    4141 
    … …  
    5454      !! 
    5555      !! ** Method  : - Read namelist namsbc_apr 
    56       !!              - Read Patm fields in netcdf files  
     56      !!              - Read Patm fields in netcdf files 
    5757      !!              - Compute reference atmospheric pressure 
    5858      !!              - Compute inverse barometer ssh 
    … …  
    6060      !!                ssh_ib   : inverse barometer ssh at kt 
    6161      !!--------------------------------------------------------------------- 
    62       INTEGER            ::   ierror  ! local integer  
     62      INTEGER            ::   ierror  ! local integer 
    6363      INTEGER            ::   ios     ! Local integer output status for namelist read 
    6464      !! 
    … …  
    103103         IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data' 
    104104      ENDIF 
    105 !jc: stop below should rather be a warning  
     105!jc: stop below should rather be a warning 
    106106      IF( ln_apr_obc .AND. .NOT.ln_apr_dyn   )   & 
    107107            CALL ctl_warn( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 
    … …  
    116116      !! 
    117117      !! ** Method  : - Read namelist namsbc_apr 
    118       !!              - Read Patm fields in netcdf files  
     118      !!              - Read Patm fields in netcdf files 
    119119      !!              - Compute reference atmospheric pressure 
    120120      !!              - Compute inverse barometer ssh 
    … …  
    148148         !                                      ! ---------------------------------------- ! 
    149149         !                                            !* Restart: read in restart file 
    150          IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN  
     150         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN 
    151151            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file' 
    152152            CALL iom_get( numror, jpdom_auto, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh 
    … …  
    167167      ! 
    168168   END SUBROUTINE sbc_apr 
    169        
     169 
    170170   !!====================================================================== 
    171171END MODULE sbcapr 

  • NEMO/trunk/src/OCE/SBC/sbcblk.F90

    r14007 r14072  
    1919   !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce conduction flux emulator (M. Vancoppenolle) 
    2020   !!            4.0  !  2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE) 
     21   !!            4.2  !  2020-12  (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 
    2122   !!---------------------------------------------------------------------- 
    2223 
    … …  
    3031   !!   blk_ice_2   : provide the heat and mass fluxes at air-ice interface 
    3132   !!   blk_ice_qcn   : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux) 
    32    !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag 
    33    !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
    3433   !!---------------------------------------------------------------------- 
    3534   USE oce            ! ocean dynamics and tracers 
    … …  
    4140   USE sbcdcy         ! surface boundary condition: diurnal cycle 
    4241   USE sbcwave , ONLY :   cdn_wave ! wave module 
    43    USE sbc_ice        ! Surface boundary condition: ice fields 
    4442   USE lib_fortran    ! to use key_nosignedzero 
     43   ! 
    4544#if defined key_si3 
     45   USE sbc_ice        ! Surface boundary condition: ice fields #LB? ok to be in 'key_si3' ??? 
    4646   USE ice     , ONLY :   u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif, nn_qtrice 
    4747   USE icevar         ! for CALL ice_var_snwblow 
    48 #endif 
    49    USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009) 
     48   USE sbcblk_algo_ice_an05 
     49   USE sbcblk_algo_ice_lu12 
     50   USE sbcblk_algo_ice_lg15 
     51#endif 
     52   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - (formerly known as CORE, Large & Yeager, 2009) 
    5053   USE sbcblk_algo_coare3p0 ! => turb_coare3p0 : COAREv3.0 (Fairall et al. 2003) 
    5154   USE sbcblk_algo_coare3p6 ! => turb_coare3p6 : COAREv3.6 (Fairall et al. 2018 + Edson et al. 2013) 
    5255   USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 45r1) 
     56   USE sbcblk_algo_andreas  ! => turb_andreas  : Andreas et al. 2015 
    5357   ! 
    5458   USE iom            ! I/O manager library 
    … …  
    5862   USE prtctl         ! Print control 
    5963 
    60    USE sbcblk_phy     ! a catalog of functions for physical/meteorological parameters in the marine boundary layer, rho_air, q_sat, etc... 
    61  
     64   USE sbc_phy        ! Catalog of functions for physical/meteorological parameters in the marine boundary layer 
    6265 
    6366   IMPLICIT NONE 
    … …  
    100103   LOGICAL  ::   ln_COARE_3p6   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
    101104   LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 45r1) 
     105   LOGICAL  ::   ln_ANDREAS     ! "ANDREAS"   algorithm   (Andreas et al. 2015) 
    102106   ! 
    103    LOGICAL  ::   ln_Cd_L12      ! ice-atm drag = F( ice concentration )                        (Lupkes et al. JGR2012) 
    104    LOGICAL  ::   ln_Cd_L15      ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 
     107   !#LB: 
     108   LOGICAL  ::   ln_Cx_ice_cst             ! use constant air-ice bulk transfer coefficients (value given in namelist's rn_Cd_i, rn_Ce_i & rn_Ch_i) 
     109   REAL(wp) ::   rn_Cd_i, rn_Ce_i, rn_Ch_i ! values for  "    " 
     110   LOGICAL  ::   ln_Cx_ice_AN05            ! air-ice bulk transfer coefficients based on Andreas et al., 2005 
     111   LOGICAL  ::   ln_Cx_ice_LU12            ! air-ice bulk transfer coefficients based on Lupkes et al., 2012 
     112   LOGICAL  ::   ln_Cx_ice_LG15            ! air-ice bulk transfer coefficients based on Lupkes & Gryanik, 2015 
     113   !#LB. 
    105114   ! 
    106115   LOGICAL  ::   ln_crt_fbk     ! Add surface current feedback to the wind stress computation  (Renault et al. 2020) 
    107116   REAL(wp) ::   rn_stau_a      ! Alpha and Beta coefficients of Renault et al. 2020, eq. 10: Stau = Alpha * Wnd + Beta 
    108    REAL(wp) ::   rn_stau_b      !  
     117   REAL(wp) ::   rn_stau_b      ! 
    109118   ! 
    110119   REAL(wp)         ::   rn_pfac   ! multiplication factor for precipitation 
    … …  
    113122   REAL(wp)         ::   rn_zu     ! z(u)   : height of wind measurements 
    114123   ! 
    115    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   Cdn_oce, Chn_oce, Cen_oce  ! neutral coeffs over ocean (L15 bulk scheme and ABL) 
    116    REAL(wp),         ALLOCATABLE, DIMENSION(:,:) ::   Cd_ice , Ch_ice , Ce_ice   ! transfert coefficients over ice 
    117    REAL(wp),         ALLOCATABLE, DIMENSION(:,:) ::   t_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) 
     124   INTEGER          :: nn_iter_algo   !  Number of iterations in bulk param. algo ("stable ABL + weak wind" requires more) 
     125 
     126   REAL(wp),         ALLOCATABLE, DIMENSION(:,:) ::   theta_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) 
     127 
     128#if defined key_si3 
     129   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cd_ice , Ch_ice , Ce_ice   !#LB transfert coefficients over ice 
     130   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: theta_zu_i, q_zu_i         !#LB fixme ! air temp. and spec. hum. over ice at wind speed height (L15 bulk scheme) 
     131#endif 
     132 
    118133 
    119134   LOGICAL  ::   ln_skin_cs     ! use the cool-skin (only available in ECMWF and COARE algorithms) !LB 
    … …  
    122137   LOGICAL  ::   ln_humi_dpt    ! humidity read in files ("sn_humi") is dew-point temperature [K] if .true. !LB 
    123138   LOGICAL  ::   ln_humi_rlh    ! humidity read in files ("sn_humi") is relative humidity     [%] if .true. !LB 
    124    LOGICAL  ::   ln_tpot        !!GS: flag to compute or not potential temperature 
     139   LOGICAL  ::   ln_tair_pot    ! temperature read in files ("sn_tair") is already potential temperature (not absolute) 
    125140   ! 
    126141   INTEGER  ::   nhumi          ! choice of the bulk algorithm 
    … …  
    136151   INTEGER, PARAMETER ::   np_COARE_3p6 = 3   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
    137152   INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 45r1) 
     153   INTEGER, PARAMETER ::   np_ANDREAS   = 5   ! "ANDREAS" algorithm       (Andreas et al. 2015) 
     154 
     155   !#LB: 
     156#if defined key_si3 
     157   ! Same, over sea-ice: 
     158   INTEGER  ::   nblk_ice           ! choice of the bulk algorithm 
     159   !                            ! associated indices: 
     160   INTEGER, PARAMETER ::   np_ice_cst  = 1   ! constant transfer coefficients 
     161   INTEGER, PARAMETER ::   np_ice_an05 = 2   ! Andreas et al., 2005 
     162   INTEGER, PARAMETER ::   np_ice_lu12 = 3   ! Lupkes el al., 2012 
     163   INTEGER, PARAMETER ::   np_ice_lg15 = 4   ! Lupkes & Gryanik, 2015 
     164#endif 
     165   !LB. 
     166 
     167 
    138168 
    139169   !! * Substitutions 
    … …  
    150180      !!             ***  ROUTINE sbc_blk_alloc *** 
    151181      !!------------------------------------------------------------------- 
    152       ALLOCATE( t_zu(jpi,jpj)   , q_zu(jpi,jpj)   ,                                      & 
    153          &      Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj),                    & 
    154          &      Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), STAT=sbc_blk_alloc ) 
    155       ! 
     182      ALLOCATE( theta_zu(jpi,jpj), q_zu(jpi,jpj),  STAT=sbc_blk_alloc ) 
    156183      CALL mpp_sum ( 'sbcblk', sbc_blk_alloc ) 
    157184      IF( sbc_blk_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_alloc: failed to allocate arrays' ) 
    158185   END FUNCTION sbc_blk_alloc 
     186 
     187#if defined key_si3 
     188   INTEGER FUNCTION sbc_blk_ice_alloc() 
     189      !!------------------------------------------------------------------- 
     190      !!             ***  ROUTINE sbc_blk_ice_alloc *** 
     191      !!------------------------------------------------------------------- 
     192      ALLOCATE( Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj),         & 
     193         &      theta_zu_i(jpi,jpj), q_zu_i(jpi,jpj),  STAT=sbc_blk_ice_alloc ) 
     194      CALL mpp_sum ( 'sbcblk', sbc_blk_ice_alloc ) 
     195      IF( sbc_blk_ice_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_ice_alloc: failed to allocate arrays' ) 
     196   END FUNCTION sbc_blk_ice_alloc 
     197#endif 
    159198 
    160199 
    … …  
    178217      TYPE(FLD_N) ::   sn_cc, sn_hpgi, sn_hpgj                 !       "                        " 
    179218      INTEGER     ::   ipka                                    ! number of levels in the atmospheric variable 
    180       NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields 
    181          &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_uoatm, sn_voatm,     & 
    182          &                 sn_cc, sn_hpgi, sn_hpgj,                                   & 
    183          &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF,             &   ! bulk algorithm 
    184          &                 cn_dir , rn_zqt, rn_zu,                                    & 
    185          &                 rn_pfac, rn_efac, ln_Cd_L12, ln_Cd_L15, ln_tpot,           & 
     219      NAMELIST/namsbc_blk/ ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF, ln_ANDREAS, &   ! bulk algorithm 
     220         &                 rn_zqt, rn_zu, nn_iter_algo, ln_skin_cs, ln_skin_wl,       & 
     221         &                 rn_pfac, rn_efac,                                          & 
    186222         &                 ln_crt_fbk, rn_stau_a, rn_stau_b,                          &   ! current feedback 
    187          &                 ln_skin_cs, ln_skin_wl, ln_humi_sph, ln_humi_dpt, ln_humi_rlh  ! cool-skin / warm-layer !LB 
     223         &                 ln_humi_sph, ln_humi_dpt, ln_humi_rlh, ln_tair_pot,        & 
     224         &                 ln_Cx_ice_cst, rn_Cd_i, rn_Ce_i, rn_Ch_i,                  & 
     225         &                 ln_Cx_ice_AN05, ln_Cx_ice_LU12, ln_Cx_ice_LG15,            & 
     226         &                 cn_dir,                                                    & 
     227         &                 sn_wndi, sn_wndj, sn_qsr, sn_qlw ,                         &   ! input fields 
     228         &                 sn_tair, sn_humi, sn_prec, sn_snow, sn_slp,                & 
     229         &                 sn_uoatm, sn_voatm, sn_cc, sn_hpgi, sn_hpgj 
     230 
     231      ! cool-skin / warm-layer !LB 
    188232      !!--------------------------------------------------------------------- 
    189233      ! 
    190234      !                                      ! allocate sbc_blk_core array 
    191       IF( sbc_blk_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard arrays' ) 
     235      IF( sbc_blk_alloc()     /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard arrays' ) 
     236      ! 
     237#if defined key_si3 
     238      IF( sbc_blk_ice_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard ice arrays' ) 
     239#endif 
    192240      ! 
    193241      !                             !** read bulk namelist 
    … …  
    215263         nblk =  np_ECMWF       ;   ioptio = ioptio + 1 
    216264      ENDIF 
     265      IF( ln_ANDREAS     ) THEN 
     266         nblk =  np_ANDREAS       ;   ioptio = ioptio + 1 
     267      ENDIF 
    217268      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one bulk algorithm' ) 
    218269 
    … …  
    222273         IF( ln_NCAR )      & 
    223274            & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with NCAR algorithm' ) 
     275         IF( ln_ANDREAS )      & 
     276            & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with ANDREAS algorithm' ) 
    224277         IF( nn_fsbc /= 1 ) & 
    225278            & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.') 
    … …  
    254307         ENDIF 
    255308      ENDIF 
     309 
     310#if defined key_si3 
     311      ioptio = 0 
     312      IF( ln_Cx_ice_cst ) THEN 
     313         nblk_ice =  np_ice_cst     ;   ioptio = ioptio + 1 
     314      ENDIF 
     315      IF( ln_Cx_ice_AN05 ) THEN 
     316         nblk_ice =  np_ice_an05   ;   ioptio = ioptio + 1 
     317      ENDIF 
     318      IF( ln_Cx_ice_LU12 ) THEN 
     319         nblk_ice =  np_ice_lu12    ;   ioptio = ioptio + 1 
     320      ENDIF 
     321      IF( ln_Cx_ice_LG15 ) THEN 
     322         nblk_ice =  np_ice_lg15   ;   ioptio = ioptio + 1 
     323      ENDIF 
     324      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one ice-atm bulk algorithm' ) 
     325#endif 
     326 
     327 
    256328      !                                   !* set the bulk structure 
    257329      !                                      !- store namelist information in an array 
    … …  
    322394      ENDIF 
    323395      ! 
    324       ! set transfer coefficients to default sea-ice values 
    325       Cd_ice(:,:) = rCd_ice 
    326       Ch_ice(:,:) = rCd_ice 
    327       Ce_ice(:,:) = rCd_ice 
    328396      ! 
    329397      IF(lwp) THEN                     !** Control print 
    … …  
    331399         WRITE(numout,*)                  !* namelist 
    332400         WRITE(numout,*) '   Namelist namsbc_blk (other than data information):' 
    333          WRITE(numout,*) '      "NCAR"      algorithm   (Large and Yeager 2008)     ln_NCAR      = ', ln_NCAR 
     401         WRITE(numout,*) '      "NCAR"      algorithm   (Large and Yeager 2008)      ln_NCAR      = ', ln_NCAR 
    334402         WRITE(numout,*) '      "COARE 3.0" algorithm   (Fairall et al. 2003)       ln_COARE_3p0 = ', ln_COARE_3p0 
    335          WRITE(numout,*) '      "COARE 3.6" algorithm (Fairall 2018 + Edson al 2013)ln_COARE_3p6 = ', ln_COARE_3p6 
    336          WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 45r1)            ln_ECMWF     = ', ln_ECMWF 
     403         WRITE(numout,*) '      "COARE 3.6" algorithm (Fairall 2018 + Edson al 2013) ln_COARE_3p6 = ', ln_COARE_3p6 
     404         WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 45r1)             ln_ECMWF     = ', ln_ECMWF 
     405         WRITE(numout,*) '      "ANDREAS"   algorithm   (Andreas et al. 2015)       ln_ANDREAS   = ', ln_ANDREAS 
    337406         WRITE(numout,*) '      Air temperature and humidity reference height (m)   rn_zqt       = ', rn_zqt 
    338407         WRITE(numout,*) '      Wind vector reference height (m)                    rn_zu        = ', rn_zu 
    … …  
    340409         WRITE(numout,*) '      factor applied on evaporation                       rn_efac      = ', rn_efac 
    341410         WRITE(numout,*) '         (form absolute (=0) to relative winds(=1))' 
    342          WRITE(numout,*) '      use ice-atm drag from Lupkes2012                    ln_Cd_L12    = ', ln_Cd_L12 
    343          WRITE(numout,*) '      use ice-atm drag from Lupkes2015                    ln_Cd_L15    = ', ln_Cd_L15 
    344411         WRITE(numout,*) '      use surface current feedback on wind stress         ln_crt_fbk   = ', ln_crt_fbk 
    345412         IF(ln_crt_fbk) THEN 
    … …  
    355422         CASE( np_COARE_3p6 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.6" algorithm (Fairall 2018+Edson et al. 2013)' 
    356423         CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 45r1)' 
     424         CASE( np_ANDREAS   )   ;   WRITE(numout,*) '   ==>>>   "ANDREAS" algorithm (Andreas et al. 2015)' 
    357425         END SELECT 
    358426         ! 
    … …  
    367435         CASE( np_humi_rlh )   ;   WRITE(numout,*) '   ==>>>   air humidity is RELATIVE HUMIDITY     [%]' 
    368436         END SELECT 
     437         ! 
     438         !#LB: 
     439#if defined key_si3 
     440         IF( nn_ice > 0 ) THEN 
     441            WRITE(numout,*) 
     442            WRITE(numout,*) '      use constant ice-atm bulk transfer coeff.           ln_Cx_ice_cst  = ', ln_Cx_ice_cst 
     443            WRITE(numout,*) '      use ice-atm bulk coeff. from Andreas et al., 2005   ln_Cx_ice_AN05 = ', ln_Cx_ice_AN05 
     444            WRITE(numout,*) '      use ice-atm bulk coeff. from Lupkes et al., 2012    ln_Cx_ice_LU12 = ', ln_Cx_ice_LU12 
     445            WRITE(numout,*) '      use ice-atm bulk coeff. from Lupkes & Gryanik, 2015 ln_Cx_ice_LG15 = ', ln_Cx_ice_LG15 
     446         ENDIF 
     447         WRITE(numout,*) 
     448         SELECT CASE( nblk_ice )              !* Print the choice of bulk algorithm 
     449         CASE( np_ice_cst  ) 
     450            WRITE(numout,*) '   ==>>>   Constant bulk transfer coefficients over sea-ice:' 
     451            WRITE(numout,*) '      => Cd_ice, Ce_ice, Ch_ice =', REAL(rn_Cd_i,4), REAL(rn_Ce_i,4), REAL(rn_Ch_i,4) 
     452            IF( (rn_Cd_i<0._wp).OR.(rn_Cd_i>1.E-2_wp).OR.(rn_Ce_i<0._wp).OR.(rn_Ce_i>1.E-2_wp).OR.(rn_Ch_i<0._wp).OR.(rn_Ch_i>1.E-2_wp) ) & 
     453               & CALL ctl_stop( 'Be realistic in your pick of Cd_ice, Ce_ice & Ch_ice ! (0 < Cx < 1.E-2)') 
     454         CASE( np_ice_an05 )   ;   WRITE(numout,*) '   ==>>> bulk algo over ice: Andreas et al, 2005' 
     455         CASE( np_ice_lu12 )   ;   WRITE(numout,*) '   ==>>> bulk algo over ice: Lupkes et al, 2012' 
     456         CASE( np_ice_lg15 )   ;   WRITE(numout,*) '   ==>>> bulk algo over ice: Lupkes & Gryanik, 2015' 
     457         END SELECT 
     458#endif 
     459         !#LB. 
    369460         ! 
    370461      ENDIF 
    … …  
    409500      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    410501      !!---------------------------------------------------------------------- 
    411       REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zevp 
     502      REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zlat, zevp 
    412503      REAL(wp) :: ztmp 
    413504      !!---------------------------------------------------------------------- 
    … …  
    446537      !                                            ! compute the surface ocean fluxes using bulk formulea 
    447538      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
     539 
     540         ! Specific humidity of air at z=rn_zqt ! 
     541         SELECT CASE( nhumi ) 
     542         CASE( np_humi_sph ) 
     543            q_air_zt(:,:) = sf(jp_humi )%fnow(:,:,1)      ! what we read in file is already a spec. humidity! 
     544         CASE( np_humi_dpt ) 
     545            IF((kt==nit000).AND.lwp) WRITE(numout,*) ' *** sbc_blk() => computing q_air out of dew-point and P !' 
     546            q_air_zt(:,:) = q_sat( sf(jp_humi )%fnow(:,:,1), sf(jp_slp  )%fnow(:,:,1) ) 
     547         CASE( np_humi_rlh ) 
     548            IF((kt==nit000).AND.lwp) WRITE(numout,*) ' *** sbc_blk() => computing q_air out of RH, t_air and slp !' !LBrm 
     549            q_air_zt(:,:) = q_air_rh( 0.01_wp*sf(jp_humi )%fnow(:,:,1), & 
     550               &                      sf(jp_tair )%fnow(:,:,1), sf(jp_slp  )%fnow(:,:,1) ) !#LB: 0.01 => RH is % percent in file 
     551         END SELECT 
     552 
     553         ! POTENTIAL temperature of air at z=rn_zqt 
     554         !      based on adiabatic lapse-rate (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2 
     555         !      (most reanalysis products provide absolute temp., not potential temp.) 
     556         IF( ln_tair_pot ) THEN 
     557            ! temperature read into file is already potential temperature, do nothing... 
     558            theta_air_zt(:,:) = sf(jp_tair )%fnow(:,:,1) 
     559         ELSE 
     560            ! temperature read into file is ABSOLUTE temperature (that's the case for ECMWF products for example...) 
     561            IF((kt==nit000).AND.lwp) WRITE(numout,*) ' *** sbc_blk() => air temperature converted from ABSOLUTE to POTENTIAL!' 
     562            theta_air_zt(:,:) = sf(jp_tair )%fnow(:,:,1) + gamma_moist( sf(jp_tair )%fnow(:,:,1), q_air_zt(:,:) ) * rn_zqt 
     563         ENDIF 
     564         ! 
    448565         CALL blk_oce_1( kt, sf(jp_wndi )%fnow(:,:,1), sf(jp_wndj )%fnow(:,:,1),   &   !   <<= in 
    449             &                sf(jp_tair )%fnow(:,:,1), sf(jp_humi )%fnow(:,:,1),   &   !   <<= in 
     566            &                theta_air_zt(:,:), q_air_zt(:,:),                     &   !   <<= in 
    450567            &                sf(jp_slp  )%fnow(:,:,1), sst_m, ssu_m, ssv_m,        &   !   <<= in 
    451568            &                sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1),   &   !   <<= in 
    452569            &                sf(jp_qsr  )%fnow(:,:,1), sf(jp_qlw  )%fnow(:,:,1),   &   !   <<= in (wl/cs) 
    453             &                tsk_m, zssq, zcd_du, zsen, zevp )                         !   =>> out 
    454  
    455          CALL blk_oce_2(     sf(jp_tair )%fnow(:,:,1), sf(jp_qsr  )%fnow(:,:,1),   &   !   <<= in 
     570            &                tsk_m, zssq, zcd_du, zsen, zlat, zevp )                   !   =>> out 
     571 
     572         CALL blk_oce_2(     theta_air_zt(:,:),                                    &   !   <<= in 
    456573            &                sf(jp_qlw  )%fnow(:,:,1), sf(jp_prec )%fnow(:,:,1),   &   !   <<= in 
    457574            &                sf(jp_snow )%fnow(:,:,1), tsk_m,                      &   !   <<= in 
    458             &                zsen, zevp )                                              !   <=> in out 
     575            &                zsen, zlat, zevp )                                        !   <=> in out 
    459576      ENDIF 
    460577      ! 
    … …  
    467584            qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1) 
    468585         ENDIF 
    469          tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1) 
    470  
    471          SELECT CASE( nhumi ) 
    472          CASE( np_humi_sph ) 
    473             qatm_ice(:,:) =           sf(jp_humi)%fnow(:,:,1) 
    474          CASE( np_humi_dpt ) 
    475             qatm_ice(:,:) = q_sat(    sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
    476          CASE( np_humi_rlh ) 
    477             qatm_ice(:,:) = q_air_rh( 0.01_wp*sf(jp_humi)%fnow(:,:,1), sf(jp_tair)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) !LB: 0.01 => RH is % percent in file 
    478          END SELECT 
     586         tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)    !#LB: should it be POTENTIAL temperature instead ???? 
     587         !tatm_ice(:,:) = theta_air_zt(:,:)         !#LB: THIS! ? 
     588 
     589         qatm_ice(:,:) = q_air_zt(:,:) !#LB: 
    479590 
    480591         tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac 
    … …  
    488599 
    489600 
    490    SUBROUTINE blk_oce_1( kt, pwndi, pwndj, ptair, phumi,         &  ! inp 
     601   SUBROUTINE blk_oce_1( kt, pwndi, pwndj, ptair, pqair,         &  ! inp 
    491602      &                      pslp , pst  , pu   , pv,            &  ! inp 
    492       &                      puatm, pvatm, pqsr , pqlw ,         &  ! inp 
    493       &                      ptsk , pssq , pcd_du, psen, pevp   )  ! out 
     603      &                      puatm, pvatm, pdqsr , pdqlw ,       &  ! inp 
     604      &                      ptsk , pssq , pcd_du, psen, plat, pevp ) ! out 
    494605      !!--------------------------------------------------------------------- 
    495606      !!                     ***  ROUTINE blk_oce_1  *** 
    … …  
    504615      !! ** Outputs : - pssq    : surface humidity used to compute latent heat flux (kg/kg) 
    505616      !!              - pcd_du  : Cd x |dU| at T-points  (m/s) 
    506       !!              - psen    : Ch x |dU| at T-points  (m/s) 
    507       !!              - pevp    : Ce x |dU| at T-points  (m/s) 
     617      !!              - psen    : sensible heat flux (W/m^2) 
     618      !!              - plat    : latent heat flux   (W/m^2) 
     619      !!              - pevp    : evaporation        (mm/s) #lolo 
    508620      !!--------------------------------------------------------------------- 
    509621      INTEGER , INTENT(in   )                 ::   kt     ! time step index 
    510622      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndi  ! atmospheric wind at U-point              [m/s] 
    511623      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndj  ! atmospheric wind at V-point              [m/s] 
    512       REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   phumi  ! specific humidity at T-points            [kg/kg] 
     624      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqair  ! specific humidity at T-points            [kg/kg] 
    513625      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   ptair  ! potential temperature at T-points        [Kelvin] 
    514626      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pslp   ! sea-level pressure                       [Pa] 
    … …  
    518630      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   puatm  ! surface current seen by the atm at T-point (i-component) [m/s] 
    519631      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pvatm  ! surface current seen by the atm at T-point (j-component) [m/s] 
    520       REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqsr   ! 
    521       REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqlw   ! 
     632      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pdqsr  ! downwelling solar (shortwave) radiation at surface [W/m^2] 
     633      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pdqlw  ! downwelling longwave radiation at surface [W/m^2] 
    522634      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   ptsk   ! skin temp. (or SST if CS & WL not used)  [Celsius] 
    523635      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pssq   ! specific humidity at pst                 [kg/kg] 
    524       REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pcd_du ! Cd x |dU| at T-points                    [m/s] 
    525       REAL(wp), INTENT(  out), DIMENSION(:,:) ::   psen   ! Ch x |dU| at T-points                    [m/s] 
    526       REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pevp   ! Ce x |dU| at T-points                    [m/s] 
     636      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pcd_du 
     637      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   psen 
     638      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   plat 
     639      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pevp 
    527640      ! 
    528641      INTEGER  ::   ji, jj               ! dummy loop indices 
    … …  
    534647      REAL(wp), DIMENSION(jpi,jpj) ::   ztau_i, ztau_j    ! wind stress components at T-point 
    535648      REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s] 
    536       REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K] 
    537       REAL(wp), DIMENSION(jpi,jpj) ::   zqair             ! specific humidity     of air at z=rn_zqt [kg/kg] 
    538649      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_oce           ! momentum transfert coefficient over ocean 
    539650      REAL(wp), DIMENSION(jpi,jpj) ::   zch_oce           ! sensible heat transfert coefficient over ocean 
    540651      REAL(wp), DIMENSION(jpi,jpj) ::   zce_oce           ! latent   heat transfert coefficient over ocean 
    541       REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat flux 
    542652      REAL(wp), DIMENSION(jpi,jpj) ::   zztmp1, zztmp2 
    543653      !!--------------------------------------------------------------------- 
    … …  
    578688      zztmp = 1. - albo 
    579689      IF( ln_dm2dc ) THEN 
    580          qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 
     690         qsr(:,:) = zztmp * sbc_dcy( pdqsr(:,:) ) * tmask(:,:,1) 
    581691      ELSE 
    582          qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
     692         qsr(:,:) = zztmp *          pdqsr(:,:)   * tmask(:,:,1) 
    583693      ENDIF 
    584694 
    … …  
    597707      ENDIF 
    598708 
    599       ! specific humidity of air at "rn_zqt" m above the sea 
    600       SELECT CASE( nhumi ) 
    601       CASE( np_humi_sph ) 
    602          zqair(:,:) = phumi(:,:)      ! what we read in file is already a spec. humidity! 
    603       CASE( np_humi_dpt ) 
    604          !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of d_air and slp !' !LBrm 
    605          zqair(:,:) = q_sat( phumi(:,:), pslp(:,:) ) 
    606       CASE( np_humi_rlh ) 
    607          !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of RH, t_air and slp !' !LBrm 
    608          zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file 
    609       END SELECT 
    610       ! 
    611       ! potential temperature of air at "rn_zqt" m above the sea 
    612       IF( ln_abl ) THEN 
    613          ztpot = ptair(:,:) 
    614       ELSE 
    615          ! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate 
    616          !    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2 
    617          !    (since reanalysis products provide T at z, not theta !) 
    618          !#LB: because AGRIF hates functions that return something else than a scalar, need to 
    619          !     use scalar version of gamma_moist() ... 
    620          IF( ln_tpot ) THEN 
    621             DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    622                ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 
    623             END_2D 
    624          ELSE 
    625             ztpot = ptair(:,:) 
    626          ENDIF 
    627       ENDIF 
    628  
    629709      !! Time to call the user-selected bulk parameterization for 
    630710      !!  ==  transfer coefficients  ==!   Cd, Ch, Ce at T-point, and more... 
    … …  
    632712 
    633713      CASE( np_NCAR      ) 
    634          CALL turb_ncar    ( rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm,                              & 
    635             &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    636  
     714         CALL turb_ncar    (     rn_zqt, rn_zu, ptsk, ptair, pssq, pqair, wndm, & 
     715            &                zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu , & 
     716            &                nb_iter=nn_iter_algo ) 
     717         ! 
    637718      CASE( np_COARE_3p0 ) 
    638          CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
    639             &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
    640             &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
    641  
     719         CALL turb_coare3p0( kt, rn_zqt, rn_zu, ptsk, ptair, pssq, pqair, wndm, & 
     720            &                ln_skin_cs, ln_skin_wl,                            & 
     721            &                zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu,  & 
     722            &                nb_iter=nn_iter_algo,                              & 
     723            &                Qsw=qsr(:,:), rad_lw=pdqlw(:,:), slp=pslp(:,:) ) 
     724         ! 
    642725      CASE( np_COARE_3p6 ) 
    643          CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
    644             &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
    645             &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
    646  
     726         CALL turb_coare3p6( kt, rn_zqt, rn_zu, ptsk, ptair, pssq, pqair, wndm, & 
     727            &                ln_skin_cs, ln_skin_wl,                            & 
     728            &                zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu,  & 
     729            &                nb_iter=nn_iter_algo,                              & 
     730            &                Qsw=qsr(:,:), rad_lw=pdqlw(:,:), slp=pslp(:,:) ) 
     731         ! 
    647732      CASE( np_ECMWF     ) 
    648          CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl,  & 
    649             &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
    650             &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
    651  
     733         CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, ptsk, ptair, pssq, pqair, wndm, & 
     734            &                ln_skin_cs, ln_skin_wl,                            & 
     735            &                zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu,  & 
     736            &                nb_iter=nn_iter_algo,                              & 
     737            &                Qsw=qsr(:,:), rad_lw=pdqlw(:,:), slp=pslp(:,:) ) 
     738         ! 
     739      CASE( np_ANDREAS   ) 
     740         CALL turb_andreas (     rn_zqt, rn_zu, ptsk, ptair, pssq, pqair, wndm, & 
     741            &                zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu , & 
     742            &                nb_iter=nn_iter_algo   ) 
     743         ! 
    652744      CASE DEFAULT 
    653          CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) 
    654  
     745         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk parameterizaton selected' ) 
     746         ! 
    655747      END SELECT 
    656        
     748 
    657749      IF( iom_use('Cd_oce') )   CALL iom_put("Cd_oce",   zcd_oce * tmask(:,:,1)) 
    658750      IF( iom_use('Ce_oce') )   CALL iom_put("Ce_oce",   zce_oce * tmask(:,:,1)) 
    659751      IF( iom_use('Ch_oce') )   CALL iom_put("Ch_oce",   zch_oce * tmask(:,:,1)) 
    660752      !! LB: mainly here for debugging purpose: 
    661       IF( iom_use('theta_zt') ) CALL iom_put("theta_zt", (ztpot-rt0) * tmask(:,:,1)) ! potential temperature at z=zt 
    662       IF( iom_use('q_zt') )     CALL iom_put("q_zt",     zqair       * tmask(:,:,1)) ! specific humidity       " 
    663       IF( iom_use('theta_zu') ) CALL iom_put("theta_zu", (t_zu -rt0) * tmask(:,:,1)) ! potential temperature at z=zu 
     753      IF( iom_use('theta_zt') ) CALL iom_put("theta_zt", (ptair-rt0) * tmask(:,:,1)) ! potential temperature at z=zt 
     754      IF( iom_use('q_zt') )     CALL iom_put("q_zt",     pqair       * tmask(:,:,1)) ! specific humidity       " 
     755      IF( iom_use('theta_zu') ) CALL iom_put("theta_zu", (theta_zu -rt0) * tmask(:,:,1)) ! potential temperature at z=zu 
    664756      IF( iom_use('q_zu') )     CALL iom_put("q_zu",     q_zu        * tmask(:,:,1)) ! specific humidity       " 
    665757      IF( iom_use('ssq') )      CALL iom_put("ssq",      pssq        * tmask(:,:,1)) ! saturation specific humidity at z=0 
    666758      IF( iom_use('wspd_blk') ) CALL iom_put("wspd_blk", zU_zu       * tmask(:,:,1)) ! bulk wind speed at z=zu 
    667        
     759 
    668760      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
    669761         !! ptsk and pssq have been updated!!! 
    … …  
    677769      END IF 
    678770 
    679       !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbcblk_phy.F90 
     771      !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbc_phy.F90 
    680772      ! ------------------------------------------------------------- 
    681773 
    … …  
    687779            psen(ji,jj)   = zztmp * zch_oce(ji,jj) 
    688780            pevp(ji,jj)   = zztmp * zce_oce(ji,jj) 
    689             rhoa(ji,jj)   = rho_air( ptair(ji,jj), phumi(ji,jj), pslp(ji,jj) ) 
     781            rhoa(ji,jj)   = rho_air( ptair(ji,jj), pqair(ji,jj), pslp(ji,jj) ) 
    690782         END_2D 
    691783      ELSE                      !==  BLK formulation  ==!   turbulent fluxes computation 
    692          CALL BULK_FORMULA( rn_zu, ptsk(:,:), pssq(:,:), t_zu(:,:), q_zu(:,:), & 
     784         CALL BULK_FORMULA( rn_zu, ptsk(:,:), pssq(:,:), theta_zu(:,:), q_zu(:,:), & 
    693785            &               zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:),          & 
    694786            &               wndm(:,:), zU_zu(:,:), pslp(:,:),                  & 
    695             &               taum(:,:), psen(:,:), zqla(:,:),                   & 
     787            &               taum(:,:), psen(:,:), plat(:,:),                   & 
    696788            &               pEvap=pevp(:,:), prhoa=rhoa(:,:), pfact_evap=rn_efac ) 
    697789 
    698          zqla(:,:) = zqla(:,:) * tmask(:,:,1) 
    699790         psen(:,:) = psen(:,:) * tmask(:,:,1) 
     791         plat(:,:) = plat(:,:) * tmask(:,:,1) 
    700792         taum(:,:) = taum(:,:) * tmask(:,:,1) 
    701793         pevp(:,:) = pevp(:,:) * tmask(:,:,1) 
    702794 
    703795         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    704             IF( wndm(ji,jj) > 0._wp ) THEN 
    705                zztmp = taum(ji,jj) / wndm(ji,jj) 
     796         IF( wndm(ji,jj) > 0._wp ) THEN 
     797            zztmp = taum(ji,jj) / wndm(ji,jj) 
    706798#if defined key_cyclone 
    707                ztau_i(ji,jj) = zztmp * zwnd_i(ji,jj) 
    708                ztau_j(ji,jj) = zztmp * zwnd_j(ji,jj) 
     799            ztau_i(ji,jj) = zztmp * zwnd_i(ji,jj) 
     800            ztau_j(ji,jj) = zztmp * zwnd_j(ji,jj) 
    709801#else 
    710                ztau_i(ji,jj) = zztmp * pwndi(ji,jj) 
    711                ztau_j(ji,jj) = zztmp * pwndj(ji,jj) 
    712 #endif 
    713             ELSE 
    714                ztau_i(ji,jj) = 0._wp 
    715                ztau_j(ji,jj) = 0._wp                  
    716             ENDIF 
     802            ztau_i(ji,jj) = zztmp * pwndi(ji,jj) 
     803            ztau_j(ji,jj) = zztmp * pwndj(ji,jj) 
     804#endif 
     805         ELSE 
     806            ztau_i(ji,jj) = 0._wp 
     807            ztau_j(ji,jj) = 0._wp 
     808         ENDIF 
    717809         END_2D 
    718810 
    … …  
    743835         ENDIF 
    744836 
    745          CALL iom_put( "taum_oce", taum )   ! output wind stress module 
     837         ! Saving open-ocean wind-stress (module and components) on T-points: 
     838         CALL iom_put( "taum_oce",   taum(:,:)*tmask(:,:,1) )   ! output wind stress module 
     839         !#LB: These 2 lines below mostly here for 'STATION_ASF' test-case, otherwize "utau" (U-grid) and vtau" (V-grid) does the job in: [DYN/dynatf.F90]) 
     840         CALL iom_put( "utau_oce", ztau_i(:,:)*tmask(:,:,1) )  ! utau at T-points! 
     841         CALL iom_put( "vtau_oce", ztau_j(:,:)*tmask(:,:,1) )  ! vtau at T-points! 
    746842 
    747843         IF(sn_cfctl%l_prtctl) THEN 
    748             CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce_1: wndm   : ') 
    749             CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce_1: utau   : ', mask1=umask,   & 
    750                &          tab2d_2=vtau  , clinfo2='            vtau   : ', mask2=vmask ) 
     844            CALL prt_ctl( tab2d_1=pssq   , clinfo1=' blk_oce_1: pssq   : ') 
     845            CALL prt_ctl( tab2d_1=wndm   , clinfo1=' blk_oce_1: wndm   : ') 
     846            CALL prt_ctl( tab2d_1=utau   , clinfo1=' blk_oce_1: utau   : ', mask1=umask,   & 
     847               &          tab2d_2=vtau   , clinfo2='            vtau   : ', mask2=vmask ) 
     848            CALL prt_ctl( tab2d_1=zcd_oce, clinfo1=' blk_oce_1: Cd     : ') 
    751849         ENDIF 
    752850         ! 
    753851      ENDIF !IF( ln_abl ) 
    754        
     852 
    755853      ptsk(:,:) = ( ptsk(:,:) - rt0 ) * tmask(:,:,1)  ! Back to Celsius 
    756              
     854 
    757855      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
    758856         CALL iom_put( "t_skin" ,  ptsk        )  ! T_skin in Celsius 
    759857         CALL iom_put( "dt_skin" , ptsk - pst  )  ! T_skin - SST temperature difference... 
    760858      ENDIF 
    761  
    762       IF(sn_cfctl%l_prtctl) THEN 
    763          CALL prt_ctl( tab2d_1=pevp  , clinfo1=' blk_oce_1: pevp   : ' ) 
    764          CALL prt_ctl( tab2d_1=psen  , clinfo1=' blk_oce_1: psen   : ' ) 
    765          CALL prt_ctl( tab2d_1=pssq  , clinfo1=' blk_oce_1: pssq   : ' ) 
    766       ENDIF 
    767859      ! 
    768860   END SUBROUTINE blk_oce_1 
    769861 
    770862 
    771    SUBROUTINE blk_oce_2( ptair, pqsr, pqlw, pprec,  &   ! <<= in 
    772       &                  psnow, ptsk, psen, pevp     )   ! <<= in 
     863   SUBROUTINE blk_oce_2( ptair, pdqlw, pprec, psnow, &   ! <<= in 
     864      &                   ptsk, psen, plat, pevp     )   ! <<= in 
    773865      !!--------------------------------------------------------------------- 
    774866      !!                     ***  ROUTINE blk_oce_2  *** 
    … …  
    786878      !!              - emp     : evaporation minus precipitation       (kg/m2/s) 
    787879      !!--------------------------------------------------------------------- 
    788       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptair 
    789       REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqsr 
    790       REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqlw 
     880      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptair   ! potential temperature of air #LB: confirm! 
     881      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pdqlw   ! downwelling longwave radiation at surface [W/m^2] 
    791882      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pprec 
    792883      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psnow 
    793884      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptsk   ! SKIN surface temperature   [Celsius] 
    794885      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psen 
     886      REAL(wp), INTENT(in), DIMENSION(:,:) ::   plat 
    795887      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pevp 
    796888      ! 
    797889      INTEGER  ::   ji, jj               ! dummy loop indices 
    798890      REAL(wp) ::   zztmp,zz1,zz2,zz3    ! local variable 
    799       REAL(wp), DIMENSION(jpi,jpj) ::   ztskk             ! skin temp. in Kelvin  
    800       REAL(wp), DIMENSION(jpi,jpj) ::   zqlw              ! long wave and sensible heat fluxes       
    801       REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat fluxes and evaporation 
     891      REAL(wp), DIMENSION(jpi,jpj) ::   zqlw              ! net long wave radiative heat flux 
    802892      !!--------------------------------------------------------------------- 
    803893      ! 
    804894      ! local scalars ( place there for vector optimisation purposes) 
    805895 
    806  
    807       ztskk(:,:) = ptsk(:,:) + rt0  ! => ptsk in Kelvin rather than Celsius 
    808        
    809896      ! ----------------------------------------------------------------------------- ! 
    810897      !     III    Net longwave radiative FLUX                                        ! 
    811898      ! ----------------------------------------------------------------------------- ! 
    812  
    813       !! LB: now moved after Turbulent fluxes because must use the skin temperature rather that the SST 
    814       !! (ztskk is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.) 
    815       zqlw(:,:) = emiss_w * ( pqlw(:,:) - stefan*ztskk(:,:)*ztskk(:,:)*ztskk(:,:)*ztskk(:,:) ) * tmask(:,:,1)   ! Net radiative longwave flux 
    816  
    817       !  Latent flux over ocean 
    818       ! ----------------------- 
    819  
    820       ! use scalar version of L_vap() for AGRIF compatibility 
    821       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    822          zqla(ji,jj) = - L_vap( ztskk(ji,jj) ) * pevp(ji,jj)    ! Latent Heat flux !!GS: possibility to add a global qla to avoid recomputation after abl update 
    823       END_2D 
    824  
    825       IF(sn_cfctl%l_prtctl) THEN 
    826          CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce_2: zqla   : ' ) 
    827          CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce_2: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' ) 
    828  
    829       ENDIF 
     899      !! #LB: now moved after Turbulent fluxes because must use the skin temperature rather than bulk SST 
     900      !! (ptsk is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.) 
     901      zqlw(:,:) = qlw_net( pdqlw(:,:), ptsk(:,:)+rt0 ) 
    830902 
    831903      ! ----------------------------------------------------------------------------- ! 
    … …  
    836908         &         - pprec(:,:) * rn_pfac  ) * tmask(:,:,1) 
    837909      ! 
    838       qns(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                   &   ! Downward Non Solar 
     910      qns(:,:) = zqlw(:,:) + psen(:,:) + plat(:,:)                   &   ! Downward Non Solar 
    839911         &     - psnow(:,:) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip 
    840912         &     - pevp(:,:) * ptsk(:,:) * rcp                         &   ! remove evap heat content at SST 
    … …  
    846918      ! 
    847919#if defined key_si3 
    848       qns_oce(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                             ! non solar without emp (only needed by SI3) 
     920      qns_oce(:,:) = zqlw(:,:) + psen(:,:) + plat(:,:)                             ! non solar without emp (only needed by SI3) 
    849921      qsr_oce(:,:) = qsr(:,:) 
    850922#endif 
    … …  
    854926      CALL iom_put( "qlw_oce"  , zqlw )                    ! output downward longwave heat over the ocean 
    855927      CALL iom_put( "qsb_oce"  , psen )                    ! output downward sensible heat over the ocean 
    856       CALL iom_put( "qla_oce"  , zqla )                    ! output downward latent   heat over the ocean 
     928      CALL iom_put( "qla_oce"  , plat )                    ! output downward latent   heat over the ocean 
    857929      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)   ! output total precipitation [kg/m2/s] 
    858930      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)   ! output solid precipitation [kg/m2/s] 
    … …  
    861933      ! 
    862934      IF ( nn_ice == 0 ) THEN 
    863          CALL iom_put( "qemp_oce" , qns-zqlw-psen-zqla )   ! output downward heat content of E-P over the ocean 
     935         CALL iom_put( "qemp_oce" , qns-zqlw-psen-plat )   ! output downward heat content of E-P over the ocean 
    864936         CALL iom_put( "qns_oce"  ,   qns  )               ! output downward non solar heat over the ocean 
    865937         CALL iom_put( "qsr_oce"  ,   qsr  )               ! output downward solar heat over the ocean 
    … …  
    869941      IF(sn_cfctl%l_prtctl) THEN 
    870942         CALL prt_ctl(tab2d_1=zqlw , clinfo1=' blk_oce_2: zqlw  : ') 
    871          CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce_2: zqla  : ', tab2d_2=qsr  , clinfo2=' qsr   : ') 
     943         CALL prt_ctl(tab2d_1=psen , clinfo1=' blk_oce_2: psen  : ' ) 
     944         CALL prt_ctl(tab2d_1=plat , clinfo1=' blk_oce_2: plat  : ' ) 
     945         CALL prt_ctl(tab2d_1=qns  , clinfo1=' blk_oce_2: qns   : ' ) 
    872946         CALL prt_ctl(tab2d_1=emp  , clinfo1=' blk_oce_2: emp   : ') 
    873947      ENDIF 
    … …  
    883957   !!   blk_ice_2   : provide the heat and mass fluxes at air-ice interface 
    884958   !!   blk_ice_qcn : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux) 
    885    !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag 
    886    !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
    887959   !!---------------------------------------------------------------------- 
    888960 
    889    SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, phumi, pslp , puice, pvice, ptsui,  &   ! inputs 
     961   SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, pqair, pslp , puice, pvice, ptsui,  &   ! inputs 
    890962      &                  putaui, pvtaui, pseni, pevpi, pssqi, pcd_dui             )   ! optional outputs 
    891963      !!--------------------------------------------------------------------- 
    … …  
    902974      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndj   ! atmospheric wind at T-point [m/s] 
    903975      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptair   ! atmospheric wind at T-point [m/s] 
    904       REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   phumi   ! atmospheric wind at T-point [m/s] 
     976      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pqair   ! atmospheric wind at T-point [m/s] 
    905977      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   puice   ! sea-ice velocity on I or C grid [m/s] 
    906978      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pvice   ! " 
    … …  
    915987      INTEGER  ::   ji, jj    ! dummy loop indices 
    916988      REAL(wp) ::   zootm_su                      ! sea-ice surface mean temperature 
    917       REAL(wp) ::   zztmp1, zztmp2                ! temporary arrays 
    918       REAL(wp), DIMENSION(jpi,jpj) ::   zcd_dui   ! transfer coefficient for momentum      (tau) 
    919       !!--------------------------------------------------------------------- 
    920       ! 
    921  
     989      REAL(wp) ::   zztmp1, zztmp2                ! temporary scalars 
     990      REAL(wp), DIMENSION(jpi,jpj) :: ztmp        ! temporary array 
     991      !!--------------------------------------------------------------------- 
     992      ! 
     993      ! LB: ptsui is in K !!! 
     994      ! 
    922995      ! ------------------------------------------------------------ ! 
    923996      !    Wind module relative to the moving ice ( U10m - U_ice )   ! 
    … …  
    925998      ! C-grid ice dynamics :   U & V-points (same as ocean) 
    926999      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    927          wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 
     1000      wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 
    9281001      END_2D 
    9291002      ! 
    9301003      ! Make ice-atm. drag dependent on ice concentration 
    931       IF    ( ln_Cd_L12 ) THEN   ! calculate new drag from Lupkes(2012) equations 
    932          CALL Cdn10_Lupkes2012( Cd_ice ) 
    933          Ch_ice(:,:) = Cd_ice(:,:)       ! momentum and heat transfer coef. are considered identical 
    934          Ce_ice(:,:) = Cd_ice(:,:) 
    935       ELSEIF( ln_Cd_L15 ) THEN   ! calculate new drag from Lupkes(2015) equations 
    936          CALL Cdn10_Lupkes2015( ptsui, pslp, Cd_ice, Ch_ice ) 
    937          Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical 
    938       ENDIF 
    939        
    940       IF( iom_use('Cd_ice') ) CALL iom_put("Cd_ice", Cd_ice) 
    941       IF( iom_use('Ce_ice') ) CALL iom_put("Ce_ice", Ce_ice) 
    942       IF( iom_use('Ch_ice') ) CALL iom_put("Ch_ice", Ch_ice) 
    943        
    944       ! local scalars ( place there for vector optimisation purposes) 
    945       zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) 
     1004 
     1005 
     1006      SELECT CASE( nblk_ice ) 
     1007 
     1008      CASE( np_ice_cst      ) 
     1009         ! Constant bulk transfer coefficients over sea-ice: 
     1010         Cd_ice(:,:) = rn_Cd_i 
     1011         Ch_ice(:,:) = rn_Ch_i 
     1012         Ce_ice(:,:) = rn_Ce_i 
     1013         ! no height adjustment, keeping zt values: 
     1014         theta_zu_i(:,:) = ptair(:,:) 
     1015         q_zu_i(:,:)     = pqair(:,:) 
     1016 
     1017      CASE( np_ice_an05 )  ! calculate new drag from Lupkes(2015) equations 
     1018         ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ 
     1019         CALL turb_ice_an05( rn_zqt, rn_zu, ptsui, ptair, ztmp, pqair, wndm_ice,       & 
     1020            &                      Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i ) 
     1021         !! 
     1022      CASE( np_ice_lu12 ) 
     1023         ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ 
     1024         CALL turb_ice_lu12( rn_zqt, rn_zu, ptsui, ptair, ztmp, pqair, wndm_ice, fr_i, & 
     1025            &                      Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i ) 
     1026         !! 
     1027      CASE( np_ice_lg15 )  ! calculate new drag from Lupkes(2015) equations 
     1028         ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ 
     1029         CALL turb_ice_lg15( rn_zqt, rn_zu, ptsui, ptair, ztmp, pqair, wndm_ice, fr_i, & 
     1030            &                      Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i ) 
     1031         !! 
     1032      END SELECT 
     1033 
     1034      IF( iom_use('Cd_ice').OR.iom_use('Ce_ice').OR.iom_use('Ch_ice').OR.iom_use('taum_ice').OR.iom_use('utau_ice').OR.iom_use('vtau_ice') ) & 
     1035         & ztmp(:,:) = ( 1._wp - MAX(0._wp, SIGN( 1._wp, 1.E-6_wp - fr_i )) )*tmask(:,:,1) ! mask for presence of ice ! 
     1036 
     1037      IF( iom_use('Cd_ice') ) CALL iom_put("Cd_ice", Cd_ice*ztmp) 
     1038      IF( iom_use('Ce_ice') ) CALL iom_put("Ce_ice", Ce_ice*ztmp) 
     1039      IF( iom_use('Ch_ice') ) CALL iom_put("Ch_ice", Ch_ice*ztmp) 
     1040 
    9461041 
    9471042      IF( ln_blk ) THEN 
    … …  
    9501045         ! ---------------------------------------------------- ! 
    9511046         ! supress moving ice in wind stress computation as we don't know how to do it properly... 
    952          DO_2D( 0, 1, 0, 1 )    ! at T point  
    953             putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndi(ji,jj) 
    954             pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndj(ji,jj) 
     1047         DO_2D( 0, 1, 0, 1 )    ! at T point 
     1048            zztmp1        = rhoa(ji,jj) * Cd_ice(ji,jj) * wndm_ice(ji,jj) 
     1049            putaui(ji,jj) =  zztmp1 * pwndi(ji,jj) 
     1050            pvtaui(ji,jj) =  zztmp1 * pwndj(ji,jj) 
    9551051         END_2D 
     1052 
     1053         !#LB: saving the module, and x-y components, of the ai wind-stress at T-points: NOT weighted by the ice concentration !!! 
     1054         IF(iom_use('taum_ice')) CALL iom_put('taum_ice', SQRT( putaui*putaui + pvtaui*pvtaui )*ztmp ) 
     1055         !#LB: These 2 lines below mostly here for 'STATION_ASF' test-case, otherwize "utau_oi" (U-grid) and vtau_oi" (V-grid) does the job in: [ICE/icedyn_rhg_evp.F90]) 
     1056         IF(iom_use('utau_ice')) CALL iom_put("utau_ice", putaui*ztmp)  ! utau at T-points! 
     1057         IF(iom_use('vtau_ice')) CALL iom_put("vtau_ice", pvtaui*ztmp)  ! vtau at T-points! 
     1058 
    9561059         ! 
    9571060         DO_2D( 0, 0, 0, 0 )    ! U & V-points (same as ocean). 
    958             ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology  
     1061            !#LB: QUESTION?? so SI3 expects wind stress vector to be provided at U & V points? Not at T-points ? 
     1062            ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology 
    9591063            zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
    9601064            zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) ) 
    … …  
    9671071            &                               , tab2d_2=pvtaui  , clinfo2='          pvtaui : ' ) 
    9681072      ELSE ! ln_abl 
    969          zztmp1 = 11637800.0_wp 
    970          zztmp2 =    -5897.8_wp 
    9711073         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    972             pcd_dui(ji,jj) = zcd_dui (ji,jj) 
    973             pseni  (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj) 
    974             pevpi  (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj) 
    975             zootm_su       = zztmp2 / ptsui(ji,jj)   ! ptsui is in K (it can't be zero ??) 
    976             pssqi  (ji,jj) = zztmp1 * EXP( zootm_su ) / rhoa(ji,jj) 
     1074         pcd_dui(ji,jj) = wndm_ice(ji,jj) * Cd_ice(ji,jj) 
     1075         pseni  (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj) 
     1076         pevpi  (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj) 
    9771077         END_2D 
    978       ENDIF 
     1078         !#LB: 
     1079         pssqi(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ; ! more accurate way to obtain ssq ! 
     1080         !#LB. 
     1081      ENDIF !IF( ln_blk ) 
    9791082      ! 
    9801083      IF(sn_cfctl%l_prtctl)  CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ') 
    … …  
    9831086 
    9841087 
    985    SUBROUTINE blk_ice_2( ptsu, phs, phi, palb, ptair, phumi, pslp, pqlw, pprec, psnow  ) 
     1088   SUBROUTINE blk_ice_2( ptsu, phs, phi, palb, ptair, pqair, pslp, pdqlw, pprec, psnow  ) 
    9861089      !!--------------------------------------------------------------------- 
    9871090      !!                     ***  ROUTINE blk_ice_2  *** 
    … …  
    9991102      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness 
    10001103      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb   ! ice albedo (all skies) 
    1001       REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   ptair 
    1002       REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   phumi 
     1104      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   ptair  ! potential temperature of air #LB: okay ??? 
     1105      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pqair  ! specific humidity of air 
    10031106      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pslp 
    1004       REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pqlw 
     1107      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pdqlw 
    10051108      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pprec 
    10061109      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   psnow 
    10071110      !! 
    10081111      INTEGER  ::   ji, jj, jl               ! dummy loop indices 
    1009       REAL(wp) ::   zst3                     ! local variable 
     1112      REAL(wp) ::   zst, zst3, zsq           ! local variable 
    10101113      REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      - 
    1011       REAL(wp) ::   zztmp, zztmp2, z1_rLsub  !   -      - 
    1012       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_st         ! inverse of surface temperature 
     1114      REAL(wp) ::   zztmp, zzblk, zztmp1, z1_rLsub   !   -      - 
    10131115      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_qlw         ! long wave heat flux over ice 
    10141116      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_qsb         ! sensible  heat flux over ice 
    … …  
    10161118      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_dqsb        ! sensible  heat sensitivity over ice 
    10171119      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (SI3) 
    1018       REAL(wp), DIMENSION(jpi,jpj)     ::   zqair         ! specific humidity of air at z=rn_zqt [kg/kg] !LB 
    10191120      REAL(wp), DIMENSION(jpi,jpj)     ::   ztmp, ztmp2 
    10201121      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri 
    10211122      !!--------------------------------------------------------------------- 
    10221123      ! 
    1023       zcoef_dqlw = 4._wp * 0.95_wp * stefan             ! local scalars 
    1024       zcoef_dqla = -rLsub * 11637800._wp * (-5897.8_wp) !LB: BAD! 
    1025       ! 
    1026       SELECT CASE( nhumi ) 
    1027       CASE( np_humi_sph ) 
    1028          zqair(:,:) =  phumi(:,:)      ! what we read in file is already a spec. humidity! 
    1029       CASE( np_humi_dpt ) 
    1030          zqair(:,:) = q_sat( phumi(:,:), pslp ) 
    1031       CASE( np_humi_rlh ) 
    1032          zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file 
    1033       END SELECT 
    1034       ! 
     1124      zcoef_dqlw = 4._wp * emiss_i * stefan             ! local scalars 
     1125      ! 
     1126 
    10351127      zztmp = 1. / ( 1. - albo ) 
    1036       WHERE( ptsu(:,:,:) /= 0._wp ) 
    1037          z1_st(:,:,:) = 1._wp / ptsu(:,:,:) 
    1038       ELSEWHERE 
    1039          z1_st(:,:,:) = 0._wp 
    1040       END WHERE 
     1128      dqla_ice(:,:,:) = 0._wp 
     1129 
    10411130      !                                     ! ========================== ! 
    10421131      DO jl = 1, jpl                        !  Loop over ice categories  ! 
    10431132         !                                  ! ========================== ! 
    1044          DO jj = 1 , jpj 
    1045             DO ji = 1, jpi 
     1133         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     1134 
     1135               zst = ptsu(ji,jj,jl)                           ! surface temperature of sea-ice [K] 
     1136               zsq = q_sat( zst, pslp(ji,jj), l_ice=.TRUE. )  ! surface saturation specific humidity when ice present 
     1137 
    10461138               ! ----------------------------! 
    10471139               !      I   Radiative FLUXES   ! 
    10481140               ! ----------------------------! 
    1049                zst3 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 
    10501141               ! Short Wave (sw) 
    10511142               qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
     1143 
    10521144               ! Long  Wave (lw) 
    1053                z_qlw(ji,jj,jl) = 0.95 * ( pqlw(ji,jj) - stefan * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
     1145               zst3 = zst * zst * zst 
     1146               z_qlw(ji,jj,jl)   = emiss_i * ( pdqlw(ji,jj) - stefan * zst * zst3 ) * tmask(ji,jj,1) 
    10541147               ! lw sensitivity 
    1055                z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3 
     1148               z_dqlw(ji,jj,jl)  = zcoef_dqlw * zst3 
    10561149 
    10571150               ! ----------------------------! 
    … …  
    10601153 
    10611154               ! ... turbulent heat fluxes with Ch_ice recalculated in blk_ice_1 
     1155 
     1156               ! Common term in bulk F. equations... 
     1157               zzblk = rhoa(ji,jj) * wndm_ice(ji,jj) 
     1158 
    10621159               ! Sensible Heat 
    1063                z_qsb(ji,jj,jl) = rhoa(ji,jj) * rCp_air * Ch_ice(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - ptair(ji,jj)) 
     1160               zztmp1 = zzblk * rCp_air * Ch_ice(ji,jj) 
     1161               z_qsb (ji,jj,jl) = zztmp1 * (zst - theta_zu_i(ji,jj)) 
     1162               z_dqsb(ji,jj,jl) = zztmp1                        ! ==> Qsens sensitivity (Dqsb_ice/Dtn_ice) 
     1163 
    10641164               ! Latent Heat 
    1065                zztmp2 = EXP( -5897.8 * z1_st(ji,jj,jl) ) 
    1066                qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa(ji,jj) * rLsub  * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  & 
    1067                   &                ( 11637800. * zztmp2 / rhoa(ji,jj) - zqair(ji,jj) ) ) 
    1068                ! Latent heat sensitivity for ice (Dqla/Dt) 
    1069                IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 
    1070                   dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  & 
    1071                      &                 z1_st(ji,jj,jl) * z1_st(ji,jj,jl) * zztmp2 
    1072                ELSE 
    1073                   dqla_ice(ji,jj,jl) = 0._wp 
    1074                ENDIF 
    1075  
    1076                ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    1077                z_dqsb(ji,jj,jl) = rhoa(ji,jj) * rCp_air * Ch_ice(ji,jj) * wndm_ice(ji,jj) 
     1165               zztmp1 = zzblk * rLsub * Ce_ice(ji,jj) 
     1166               qla_ice(ji,jj,jl) = MAX( zztmp1 * (zsq - q_zu_i(ji,jj)) , 0._wp )   ! #LB: only sublimation (and not condensation) ??? 
     1167               IF(qla_ice(ji,jj,jl)>0._wp) dqla_ice(ji,jj,jl) = zztmp1*dq_sat_dt_ice(zst, pslp(ji,jj)) ! ==> Qlat sensitivity  (dQlat/dT) 
     1168               !                                                                                       !#LB: dq_sat_dt_ice() in "sbc_phy.F90" 
     1169               !#LB: without this unjustified "condensation sensure": 
     1170               !qla_ice( ji,jj,jl) = zztmp1 * (zsq - q_zu_i(ji,jj)) 
     1171               !dqla_ice(ji,jj,jl) = zztmp1 * dq_sat_dt_ice(zst, pslp(ji,jj)) ! ==> Qlat sensitivity  (dQlat/dT) 
     1172 
    10781173 
    10791174               ! ----------------------------! 
    … …  
    10831178               qns_ice (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - qla_ice (ji,jj,jl) 
    10841179               ! Total non solar heat flux sensitivity for ice 
    1085                dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) ) 
    1086             END DO 
    1087             ! 
    1088          END DO 
     1180               dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) ) !#LB: correct signs ???? 
     1181 
     1182         END_2D 
    10891183         ! 
    10901184      END DO 
    … …  
    11381232         ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
    11391233         DO jl = 1, jpl 
    1140             WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     1234            WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm 
    11411235               qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
    11421236            ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
    11431237               qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
    11441238            ELSEWHERE                                                         ! zero when hs>0 
    1145                qtr_ice_top(:,:,jl) = 0._wp  
     1239               qtr_ice_top(:,:,jl) = 0._wp 
    11461240            END WHERE 
    11471241         ENDDO 
    … …  
    11821276         CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice: tprecip  : ', tab2d_2=sprecip , clinfo2=' sprecip  : ') 
    11831277      ENDIF 
    1184       ! 
     1278 
     1279      !#LB: 
     1280      ! air-ice heat flux components that are not written from ice_stp()@icestp.F90: 
     1281      IF( iom_use('qla_ice') )  CALL iom_put( 'qla_ice', SUM( - qla_ice * a_i_b, dim=3 ) ) !#LB: sign consistent with what's done for ocean 
     1282      IF( iom_use('qsb_ice') )  CALL iom_put( 'qsb_ice', SUM( -   z_qsb * a_i_b, dim=3 ) ) !#LB:     ==> negative => loss of heat for sea-ice 
     1283      IF( iom_use('qlw_ice') )  CALL iom_put( 'qlw_ice', SUM(     z_qlw * a_i_b, dim=3 ) ) 
     1284      !#LB. 
     1285 
    11851286   END SUBROUTINE blk_ice_2 
    11861287 
    … …  
    12781379   END SUBROUTINE blk_ice_qcn 
    12791380 
    1280  
    1281    SUBROUTINE Cdn10_Lupkes2012( pcd ) 
    1282       !!---------------------------------------------------------------------- 
    1283       !!                      ***  ROUTINE  Cdn10_Lupkes2012  *** 
    1284       !! 
    1285       !! ** Purpose :    Recompute the neutral air-ice drag referenced at 10m 
    1286       !!                 to make it dependent on edges at leads, melt ponds and flows. 
    1287       !!                 After some approximations, this can be resumed to a dependency 
    1288       !!                 on ice concentration. 
    1289       !! 
    1290       !! ** Method :     The parameterization is taken from Lupkes et al. (2012) eq.(50) 
    1291       !!                 with the highest level of approximation: level4, eq.(59) 
    1292       !!                 The generic drag over a cell partly covered by ice can be re-written as follows: 
    1293       !! 
    1294       !!                 Cd = Cdw * (1-A) + Cdi * A + Ce * (1-A)**(nu+1/(10*beta)) * A**mu 
    1295       !! 
    1296       !!                    Ce = 2.23e-3       , as suggested by Lupkes (eq. 59) 
    1297       !!                    nu = mu = beta = 1 , as suggested by Lupkes (eq. 59) 
    1298       !!                    A is the concentration of ice minus melt ponds (if any) 
    1299       !! 
    1300       !!                 This new drag has a parabolic shape (as a function of A) starting at 
    1301       !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5 
    1302       !!                 and going down to Cdi(say 1.4e-3) for A=1 
    1303       !! 
    1304       !!                 It is theoretically applicable to all ice conditions (not only MIZ) 
    1305       !!                 => see Lupkes et al (2013) 
    1306       !! 
    1307       !! ** References : Lupkes et al. JGR 2012 (theory) 
    1308       !!                 Lupkes et al. GRL 2013 (application to GCM) 
    1309       !! 
    1310       !!---------------------------------------------------------------------- 
    1311       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd 
    1312       REAL(wp), PARAMETER ::   zCe   = 2.23e-03_wp 
    1313       REAL(wp), PARAMETER ::   znu   = 1._wp 
    1314       REAL(wp), PARAMETER ::   zmu   = 1._wp 
    1315       REAL(wp), PARAMETER ::   zbeta = 1._wp 
    1316       REAL(wp)            ::   zcoef 
    1317       !!---------------------------------------------------------------------- 
    1318       zcoef = znu + 1._wp / ( 10._wp * zbeta ) 
    1319  
    1320       ! generic drag over a cell partly covered by ice 
    1321       !!Cd(:,:) = Cd_oce(:,:) * ( 1._wp - at_i_b(:,:) ) +  &                        ! pure ocean drag 
    1322       !!   &      Cd_ice      *           at_i_b(:,:)   +  &                        ! pure ice drag 
    1323       !!   &      zCe         * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**zmu   ! change due to sea-ice morphology 
    1324  
    1325       ! ice-atm drag 
    1326       pcd(:,:) = rCd_ice +  &                                                         ! pure ice drag 
    1327          &      zCe     * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology 
    1328  
    1329    END SUBROUTINE Cdn10_Lupkes2012 
    1330  
    1331  
    1332    SUBROUTINE Cdn10_Lupkes2015( ptm_su, pslp, pcd, pch ) 
    1333       !!---------------------------------------------------------------------- 
    1334       !!                      ***  ROUTINE  Cdn10_Lupkes2015  *** 
    1335       !! 
    1336       !! ** pUrpose :    Alternative turbulent transfert coefficients formulation 
    1337       !!                 between sea-ice and atmosphere with distinct momentum 
    1338       !!                 and heat coefficients depending on sea-ice concentration 
    1339       !!                 and atmospheric stability (no meltponds effect for now). 
    1340       !! 
    1341       !! ** Method :     The parameterization is adapted from Lupkes et al. (2015) 
    1342       !!                 and ECHAM6 atmospheric model. Compared to Lupkes2012 scheme, 
    1343       !!                 it considers specific skin and form drags (Andreas et al. 2010) 
    1344       !!                 to compute neutral transfert coefficients for both heat and 
    1345       !!                 momemtum fluxes. Atmospheric stability effect on transfert 
    1346       !!                 coefficient is also taken into account following Louis (1979). 
    1347       !! 
    1348       !! ** References : Lupkes et al. JGR 2015 (theory) 
    1349       !!                 Lupkes et al. ECHAM6 documentation 2015 (implementation) 
    1350       !! 
    1351       !!---------------------------------------------------------------------- 
    1352       ! 
    1353       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   ptm_su ! sea-ice surface temperature [K] 
    1354       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pslp   ! sea-level pressure [Pa] 
    1355       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd    ! momentum transfert coefficient 
    1356       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pch    ! heat transfert coefficient 
    1357       REAL(wp), DIMENSION(jpi,jpj)            ::   zst, zqo_sat, zqi_sat 
    1358       ! 
    1359       ! ECHAM6 constants 
    1360       REAL(wp), PARAMETER ::   z0_skin_ice  = 0.69e-3_wp  ! Eq. 43 [m] 
    1361       REAL(wp), PARAMETER ::   z0_form_ice  = 0.57e-3_wp  ! Eq. 42 [m] 
    1362       REAL(wp), PARAMETER ::   z0_ice       = 1.00e-3_wp  ! Eq. 15 [m] 
    1363       REAL(wp), PARAMETER ::   zce10        = 2.80e-3_wp  ! Eq. 41 
    1364       REAL(wp), PARAMETER ::   zbeta        = 1.1_wp      ! Eq. 41 
    1365       REAL(wp), PARAMETER ::   zc           = 5._wp       ! Eq. 13 
    1366       REAL(wp), PARAMETER ::   zc2          = zc * zc 
    1367       REAL(wp), PARAMETER ::   zam          = 2. * zc     ! Eq. 14 
    1368       REAL(wp), PARAMETER ::   zah          = 3. * zc     ! Eq. 30 
    1369       REAL(wp), PARAMETER ::   z1_alpha     = 1._wp / 0.2_wp  ! Eq. 51 
    1370       REAL(wp), PARAMETER ::   z1_alphaf    = z1_alpha    ! Eq. 56 
    1371       REAL(wp), PARAMETER ::   zbetah       = 1.e-3_wp    ! Eq. 26 
    1372       REAL(wp), PARAMETER ::   zgamma       = 1.25_wp     ! Eq. 26 
    1373       REAL(wp), PARAMETER ::   z1_gamma     = 1._wp / zgamma 
    1374       REAL(wp), PARAMETER ::   r1_3         = 1._wp / 3._wp 
    1375       ! 
    1376       INTEGER  ::   ji, jj         ! dummy loop indices 
    1377       REAL(wp) ::   zthetav_os, zthetav_is, zthetav_zu 
    1378       REAL(wp) ::   zrib_o, zrib_i 
    1379       REAL(wp) ::   zCdn_skin_ice, zCdn_form_ice, zCdn_ice 
    1380       REAL(wp) ::   zChn_skin_ice, zChn_form_ice 
    1381       REAL(wp) ::   z0w, z0i, zfmi, zfmw, zfhi, zfhw 
    1382       REAL(wp) ::   zCdn_form_tmp 
    1383       !!---------------------------------------------------------------------- 
    1384  
    1385       ! Momentum Neutral Transfert Coefficients (should be a constant) 
    1386       zCdn_form_tmp = zce10 * ( LOG( 10._wp / z0_form_ice + 1._wp ) / LOG( rn_zu / z0_form_ice + 1._wp ) )**2   ! Eq. 40 
    1387       zCdn_skin_ice = ( vkarmn                                      / LOG( rn_zu / z0_skin_ice + 1._wp ) )**2   ! Eq. 7 
    1388       zCdn_ice      = zCdn_skin_ice   ! Eq. 7 
    1389       !zCdn_ice     = 1.89e-3         ! old ECHAM5 value (cf Eq. 32) 
    1390  
    1391       ! Heat Neutral Transfert Coefficients 
    1392       zChn_skin_ice = vkarmn**2 / ( LOG( rn_zu / z0_ice + 1._wp ) * LOG( rn_zu * z1_alpha / z0_skin_ice + 1._wp ) )   ! Eq. 50 + Eq. 52 
    1393  
    1394       ! Atmospheric and Surface Variables 
    1395       zst(:,:)     = sst_m(:,:) + rt0                                        ! convert SST from Celcius to Kelvin 
    1396       zqo_sat(:,:) = rdct_qsat_salt * q_sat( zst(:,:)   , pslp(:,:) )   ! saturation humidity over ocean [kg/kg] 
    1397       zqi_sat(:,:) =                  q_sat( ptm_su(:,:), pslp(:,:) )   ! saturation humidity over ice   [kg/kg] 
    1398       ! 
    1399       DO_2D( 0, 0, 0, 0 ) 
    1400          ! Virtual potential temperature [K] 
    1401          zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean 
    1402          zthetav_is = ptm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice 
    1403          zthetav_zu = t_zu (ji,jj)  * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu 
    1404  
    1405          ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead) 
    1406          zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean 
    1407          zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice 
    1408  
    1409          ! Momentum and Heat Neutral Transfert Coefficients 
    1410          zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40 
    1411          zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53 
    1412  
    1413          ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead ?) 
    1414          z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water 
    1415          z0i = z0_skin_ice                                             ! over ice 
    1416          IF( zrib_o <= 0._wp ) THEN 
    1417             zfmw = 1._wp - zam * zrib_o / ( 1._wp + 3._wp * zc2 * Cdn_oce(ji,jj) * SQRT( -zrib_o * ( rn_zu / z0w + 1._wp ) ) )  ! Eq. 10 
    1418             zfhw = ( 1._wp + ( zbetah * ( zthetav_os - zthetav_zu )**r1_3 / ( Chn_oce(ji,jj) * MAX(0.01, wndm(ji,jj)) )   &     ! Eq. 26 
    1419                &             )**zgamma )**z1_gamma 
    1420          ELSE 
    1421             zfmw = 1._wp / ( 1._wp + zam * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 12 
    1422             zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28 
    1423          ENDIF 
    1424  
    1425          IF( zrib_i <= 0._wp ) THEN 
    1426             zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9 
    1427             zfhi = 1._wp - zah * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq. 25 
    1428          ELSE 
    1429             zfmi = 1._wp / ( 1._wp + zam * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 11 
    1430             zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27 
    1431          ENDIF 
    1432  
    1433          ! Momentum Transfert Coefficients (Eq. 38) 
    1434          pcd(ji,jj) = zCdn_skin_ice *   zfmi +  & 
    1435             &        zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 
    1436  
    1437          ! Heat Transfert Coefficients (Eq. 49) 
    1438          pch(ji,jj) = zChn_skin_ice *   zfhi +  & 
    1439             &        zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 
    1440          ! 
    1441       END_2D 
    1442       CALL lbc_lnk_multi( 'sbcblk', pcd, 'T',  1.0_wp, pch, 'T', 1.0_wp ) 
    1443       ! 
    1444    END SUBROUTINE Cdn10_Lupkes2015 
    1445  
    14461381#endif 
    14471382 

  • NEMO/trunk/src/OCE/SBC/sbcblk_algo_coare3p0.F90

    r13460 r14072  
    77   !!   * bulk transfer coefficients C_D, C_E and C_H 
    88   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed 
    9    !!   * the effective bulk wind speed at 10m U_blk 
     9   !!   * the effective bulk wind speed at 10m Ubzu 
    1010   !!   => all these are used in bulk formulas in sbcblk.F90 
    1111   !! 
    … …  
    1515   !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk) 
    1616   !!---------------------------------------------------------------------- 
    17    !! History :  4.0  !  2016-02  (L.Brodeau)   Original code 
     17   !! History :  4.0  ! 2016-02  (L.Brodeau)   Original code 
     18   !!            4.2  ! 2020-12  (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 
    1819   !!---------------------------------------------------------------------- 
    1920 
    … …  
    3738 
    3839   USE sbc_oce         ! Surface boundary condition: ocean fields 
    39    USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
     40   USE sbc_phy         ! Catalog of functions for physical/meteorological parameters in the marine boundary layer 
    4041   USE sbcblk_skin_coare ! cool-skin/warm layer scheme (CSWL_ECMWF) !LB 
    4142 
    … …  
    5051   REAL(wp), PARAMETER :: zi0   = 600._wp     ! scale height of the atmospheric boundary layer... 
    5152   REAL(wp), PARAMETER :: Beta0 =  1.25_wp    ! gustiness parameter 
    52  
    53    INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations 
     53   REAL(wp), PARAMETER :: zeta_abs_max = 50._wp 
    5454 
    5555   !!---------------------------------------------------------------------- 
    … …  
    9090 
    9191   SUBROUTINE turb_coare3p0( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 
    92       &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                              & 
    93       &                      Cdn, Chn, Cen,                                              & 
     92      &                      Cd, Ch, Ce, t_zu, q_zu, Ubzu,                               & 
     93      &                      nb_iter, Cdn, Chn, Cen,                                     & ! optional output 
    9494      &                      Qsw, rad_lw, slp, pdT_cs,                                   & ! optionals for cool-skin (and warm-layer) 
    95       &                      pdT_wl, pHz_wl )                                                 ! optionals for warm-layer only 
     95      &                      pdT_wl, pHz_wl )                                              ! optionals for warm-layer only 
    9696      !!---------------------------------------------------------------------- 
    9797      !!                      ***  ROUTINE  turb_coare3p0  *** 
    … …  
    147147      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    148148      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    149       !!    *  U_blk  : bulk wind speed at zu                                 [m/s] 
     149      !!    *  Ubzu  : bulk wind speed at zu                                 [m/s] 
    150150      !! 
    151151      !! 
    … …  
    167167      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    168168      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    169       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s] 
    170       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    171       ! 
     169      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ubzu    ! bulk wind speed at zu                     [m/s] 
     170      ! 
     171      INTEGER , INTENT(in   ), OPTIONAL                     :: nb_iter  ! number of iterations 
     172      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CdN 
     173      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   ChN 
     174      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CeN 
    172175      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2] 
    173176      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2] 
    … …  
    177180      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m] 
    178181      ! 
    179       INTEGER :: j_itt 
     182      INTEGER :: nbit, jit 
    180183      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    181184      ! 
    … …  
    194197      IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P0_INIT(l_use_cs, l_use_wl) 
    195198 
     199      nbit = nb_iter0 
     200      IF( PRESENT(nb_iter) ) nbit = nb_iter 
     201 
    196202      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    197203      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) ) 
    … …  
    211217      ENDIF 
    212218 
    213  
    214219      !! First guess of temperature and humidity at height zu: 
    215220      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions... 
    … …  
    222227      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K) 
    223228 
    224       U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
     229      Ubzu = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
    225230 
    226231      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001) 
    227232      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               " 
    228       u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
    229  
    230       z0     = alfa_charn_3p0(U_zu)*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
     233      u_star = 0.035_wp*Ubzu*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
     234 
     235      z0     = charn_coare3p0(U_zu)*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
    231236      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    232237 
    … …  
    234239      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    235240 
    236       Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd 
    237  
    238       ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd 
    239  
    240       ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN) 
     241      Cd     = MAX( (vkarmn/ztmp0)**2 , Cx_min )    ! first guess of Cd 
     242 
     243      ztmp0 = vkarmn2/LOG(zt/z0t)/Cd 
     244 
     245      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, Ubzu ) ! Bulk Richardson Number (BRN) 
    241246 
    242247      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2): 
    243248      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 ) 
    244       ztmp0 = ztmp0*ztmp2 
    245       zeta_u = (1._wp-ztmp1) * (ztmp0/(1._wp+ztmp2/(-zu/(zi0*0.004_wp*Beta0**3)))) & !  BRN < 0 
    246          &  +     ztmp1   * (ztmp0*(1._wp + 27._wp/9._wp*ztmp2/ztmp0))               !  BRN > 0 
    247       !#LB: should make sure that the "ztmp0" of "27./9.*ztmp2/ztmp0" is "ztmp0*ztmp2" and not "ztmp0==vkarmn*vkarmn/LOG(zt/z0t)/Cd" ! 
     249      zeta_u = (1._wp - ztmp1) *   ztmp0*ztmp2 / (1._wp - ztmp2*zi0*0.004_wp*Beta0**3/zu) & !  BRN < 0 
     250         &  +       ztmp1      * ( ztmp0*ztmp2 + 27._wp/9._wp*ztmp2*ztmp2 )                 !  BRN > 0 
    248251 
    249252      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L 
    250253      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_coare(zeta_u)) 
    251254 
    252       u_star = MAX ( U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
     255      u_star = MAX ( Ubzu*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
    253256      t_star = dt_zu*ztmp0 
    254257      q_star = dq_zu*ztmp0 
    … …  
    269272 
    270273      !! ITERATION BLOCK 
    271       DO j_itt = 1, nb_itt 
    272  
    273          !!Inverse of Monin-Obukov length (1/L) : 
    274          ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Monin-Obukhov length] 
    275          ztmp0 = SIGN( MIN(ABS(ztmp0),200._wp), ztmp0 ) ! (prevents FPE from stupid values from masked region later on...) 
     274      DO jit = 1, nbit 
     275 
     276         !!Inverse of Obukov length (1/L) : 
     277         ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Obukhov length] 
     278         ztmp0 = SIGN( MIN(ABS(ztmp0),200._wp), ztmp0 ) ! 1/L (prevents FPE from stupid values from masked region later on...) 
    276279 
    277280         ztmp1 = u_star*u_star   ! u*^2 
    … …  
    280283         ztmp2 = Beta0*Beta0*ztmp1*(MAX(-zi0*ztmp0/vkarmn,0._wp))**(2._wp/3._wp) ! square of wind gustiness contribution, ztmp2 == Ug^2 
    281284         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0 
    282          U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
    283          ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0. 
     285         Ubzu = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
     286         ! => 0.2 prevents Ubzu to be 0 in stable case when U_zu=0. 
    284287 
    285288         !! Stability parameters: 
    286289         zeta_u = zu*ztmp0 
    287          zeta_u = SIGN( MIN(ABS(zeta_u),50.0_wp), zeta_u ) 
     290         zeta_u = SIGN( MIN(ABS(zeta_u),zeta_abs_max), zeta_u ) 
    288291         IF( .NOT. l_zt_equal_zu ) THEN 
    289292            zeta_t = zt*ztmp0 
    290             zeta_t = SIGN( MIN(ABS(zeta_t),50.0_wp), zeta_t ) 
     293            zeta_t = SIGN( MIN(ABS(zeta_t),zeta_abs_max), zeta_t ) 
    291294         ENDIF 
    292295 
    … …  
    296299         !! Roughness lengthes z0, z0t (z0q = z0t) : 
    297300         ztmp2 = u_star/vkarmn*LOG(10./z0)                                 ! Neutral wind speed at 10m 
    298          z0    = alfa_charn_3p0(ztmp2)*ztmp1/grav + 0.11_wp*znu_a/u_star   ! Roughness length (eq.6) [ ztmp1==u*^2 ] 
     301         z0    = charn_coare3p0(ztmp2)*ztmp1/grav + 0.11_wp*znu_a/u_star   ! Roughness length (eq.6) [ ztmp1==u*^2 ] 
    299302         z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    300303 
    … …  
    309312         t_star = dt_zu*ztmp1 
    310313         q_star = dq_zu*ztmp1 
    311          u_star = MAX( U_blk*vkarmn/(LOG(zu) - LOG(z0) - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
     314         u_star = MAX( Ubzu*vkarmn/(LOG(zu) - LOG(z0) - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
    312315 
    313316         IF( .NOT. l_zt_equal_zu ) THEN 
    … …  
    318321         ENDIF 
    319322 
    320  
    321323         IF( l_use_cs ) THEN 
    322324            !! Cool-skin contribution 
    323325 
    324             CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     326            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, & 
    325327               &                   ztmp1, zeta_u,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> zeta_u 
    326328 
    … …  
    330332            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1) 
    331333            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) 
    332  
    333334         ENDIF 
    334335 
    335336         IF( l_use_wl ) THEN 
    336337            !! Warm-layer contribution 
    337             CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     338            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, & 
    338339               &                   ztmp1, zeta_u)  ! Qnsol -> ztmp1 / Tau -> zeta_u 
    339340            !! In WL_COARE or , Tau_ac and Qnt_ac must be updated at the final itteration step => add a flag to do this! 
    340             CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nb_itt,j_itt) ) 
     341            CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nbit,jit) ) 
    341342 
    342343            !! Updating T_s and q_s !!! 
    … …  
    351352         ENDIF 
    352353 
    353       END DO !DO j_itt = 1, nb_itt 
     354      END DO !DO jit = 1, nbit 
    354355 
    355356      ! compute transfer coefficients at zu : 
    356       ztmp0 = u_star/U_blk 
    357       Cd   = ztmp0*ztmp0 
    358       Ch   = ztmp0*t_star/dt_zu 
    359       Ce   = ztmp0*q_star/dq_zu 
    360  
    361       ztmp1 = zu + z0 
    362       Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 )) 
    363       Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t)) 
    364       Cen = Chn 
     357      ztmp0 = u_star/Ubzu 
     358      Cd   = MAX( ztmp0*ztmp0        , Cx_min ) 
     359      Ch   = MAX( ztmp0*t_star/dt_zu , Cx_min ) 
     360      Ce   = MAX( ztmp0*q_star/dq_zu , Cx_min ) 
    365361 
    366362      IF( .NOT. l_zt_equal_zu ) DEALLOCATE( zeta_t ) 
     363 
     364      IF(PRESENT(Cdn)) Cdn = MAX( vkarmn2 / (LOG(zu/z0 )*LOG(zu/z0 )) , Cx_min ) 
     365      IF(PRESENT(Chn)) Chn = MAX( vkarmn2 / (LOG(zu/z0t)*LOG(zu/z0t)) , Cx_min ) 
     366      IF(PRESENT(Cen)) Cen = MAX( vkarmn2 / (LOG(zu/z0t)*LOG(zu/z0t)) , Cx_min ) 
    367367 
    368368      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs 
    … …  
    375375 
    376376 
    377    FUNCTION alfa_charn_3p0( pwnd ) 
     377   FUNCTION charn_coare3p0( pwnd ) 
    378378      !!------------------------------------------------------------------- 
    379379      !! Compute the Charnock parameter as a function of the wind speed 
    … …  
    387387      !! Author: L. Brodeau, June 2016 / AeroBulk  (https://github.com/brodeau/aerobulk/) 
    388388      !!------------------------------------------------------------------- 
    389       REAL(wp), DIMENSION(jpi,jpj) :: alfa_charn_3p0 
     389      REAL(wp), DIMENSION(jpi,jpj) :: charn_coare3p0 
    390390      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd   ! wind speed 
    391391      ! 
    … …  
    393393      REAL(wp) :: zw, zgt10, zgt18 
    394394      !!------------------------------------------------------------------- 
    395       ! 
    396395      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    397       ! 
    398       zw = pwnd(ji,jj)   ! wind speed 
    399       ! 
    400       ! Charnock's constant, increases with the wind : 
    401       zgt10 = 0.5 + SIGN(0.5_wp,(zw - 10))  ! If zw<10. --> 0, else --> 1 
    402       zgt18 = 0.5 + SIGN(0.5_wp,(zw - 18.)) ! If zw<18. --> 0, else --> 1 
    403       ! 
    404       alfa_charn_3p0(ji,jj) =  (1. - zgt10)*0.011    &    ! wind is lower than 10 m/s 
    405          &     + zgt10*((1. - zgt18)*(0.011 + (0.018 - 0.011) & 
    406          &      *(zw - 10.)/(18. - 10.)) + zgt18*( 0.018 ) )    ! Hare et al. (1999) 
    407       ! 
     396            ! 
     397            zw = pwnd(ji,jj)   ! wind speed 
     398            ! 
     399            ! Charnock's constant, increases with the wind : 
     400            zgt10 = 0.5 + SIGN(0.5_wp,(zw - 10))  ! If zw<10. --> 0, else --> 1 
     401            zgt18 = 0.5 + SIGN(0.5_wp,(zw - 18.)) ! If zw<18. --> 0, else --> 1 
     402            ! 
     403            charn_coare3p0(ji,jj) =  (1. - zgt10)*0.011    &    ! wind is lower than 10 m/s 
     404               &     + zgt10*((1. - zgt18)*(0.011 + (0.018 - 0.011) & 
     405               &      *(zw - 10.)/(18. - 10.)) + zgt18*( 0.018 ) )    ! Hare et al. (1999) 
     406            ! 
    408407      END_2D 
    409       ! 
    410    END FUNCTION alfa_charn_3p0 
     408   END FUNCTION charn_coare3p0 
    411409 
    412410   FUNCTION psi_m_coare( pzeta ) 
    … …  
    429427      REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 
    430428      !!---------------------------------------------------------------------------------- 
    431       ! 
    432429      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    433       ! 
    434       zta = pzeta(ji,jj) 
    435       ! 
    436       zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
    437       ! 
    438       zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
    439          & - 2.*ATAN(zphi_m) + 0.5*rpi 
    440       ! 
    441       zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
    442       ! 
    443       zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    444          &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    445       ! 
    446       zf = zta*zta 
    447       zf = zf/(1. + zf) 
    448       zc = MIN(50._wp, 0.35_wp*zta) 
    449       zstab = 0.5 + SIGN(0.5_wp, zta) 
    450       ! 
    451       psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
    452          &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
    453          &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     " 
    454       ! 
     430            ! 
     431            zta = pzeta(ji,jj) 
     432            ! 
     433            zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
     434            ! 
     435            zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
     436               & - 2.*ATAN(zphi_m) + 0.5*rpi 
     437            ! 
     438            zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
     439            ! 
     440            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     441               &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     442            ! 
     443            zf = zta*zta 
     444            zf = zf/(1. + zf) 
     445            zc = MIN(50._wp, 0.35_wp*zta) 
     446            zstab = 0.5 + SIGN(0.5_wp, zta) 
     447            ! 
     448            psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
     449               &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
     450               &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )  !     " 
    455451      END_2D 
    456       ! 
    457452   END FUNCTION psi_m_coare 
    458453 
    … …  
    474469      !!         (https://github.com/brodeau/aerobulk/) 
    475470      !!---------------------------------------------------------------- 
    476       !! 
    477471      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare 
    478472      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
    … …  
    480474      INTEGER  ::   ji, jj     ! dummy loop indices 
    481475      REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 
    482       ! 
     476      !!---------------------------------------------------------------- 
    483477      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    484       ! 
    485       zta = pzeta(ji,jj) 
    486       ! 
    487       zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
    488       ! 
    489       zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
    490       ! 
    491       zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
    492       ! 
    493       zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    494          &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    495       ! 
    496       zf = zta*zta 
    497       zf = zf/(1. + zf) 
    498       zc = MIN(50._wp,0.35_wp*zta) 
    499       zstab = 0.5 + SIGN(0.5_wp, zta) 
    500       ! 
    501       psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
    502          &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
    503          &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
    504       ! 
     478            ! 
     479            zta = pzeta(ji,jj) 
     480            ! 
     481            zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
     482            ! 
     483            zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
     484            ! 
     485            zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
     486            ! 
     487            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     488               &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     489            ! 
     490            zf = zta*zta 
     491            zf = zf/(1. + zf) 
     492            zc = MIN(50._wp,0.35_wp*zta) 
     493            zstab = 0.5 + SIGN(0.5_wp, zta) 
     494            ! 
     495            psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
     496               &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
     497               &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
    505498      END_2D 
    506       ! 
    507499   END FUNCTION psi_h_coare 
    508500 

  • NEMO/trunk/src/OCE/SBC/sbcblk_algo_coare3p6.F90

    r13460 r14072  
    77   !!   * bulk transfer coefficients C_D, C_E and C_H 
    88   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed 
    9    !!   * the effective bulk wind speed at 10m U_blk 
     9   !!   * the effective bulk wind speed at 10m Ubzu 
    1010   !!   => all these are used in bulk formulas in sbcblk.F90 
    1111   !! 
    … …  
    1616   !!---------------------------------------------------------------------- 
    1717   !! History :  4.0  !  2016-02  (L.Brodeau)   Original code 
     18   !!            4.2  !  2020-12  (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 
    1819   !!---------------------------------------------------------------------- 
    1920 
    … …  
    2324   !!                   returns the effective bulk wind speed at 10m 
    2425   !!---------------------------------------------------------------------- 
    25    USE oce             ! ocean dynamics and tracers 
    2626   USE dom_oce         ! ocean space and time domain 
    2727   USE phycst          ! physical constants 
    28    USE iom             ! I/O manager library 
    29    USE lib_mpp         ! distribued memory computing library 
    30    USE in_out_manager  ! I/O manager 
    31    USE prtctl          ! Print control 
    32    USE sbcwave, ONLY   :  cdn_wave ! wave module 
    33 #if defined key_si3 || defined key_cice 
    34    USE sbc_ice         ! Surface boundary condition: ice fields 
    35 #endif 
    36    USE lib_fortran     ! to use key_nosignedzero 
    37  
    38    USE sbc_oce         ! Surface boundary condition: ocean fields 
    39    USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
     28   USE lib_mpp,        ONLY: ctl_stop         ! distribued memory computing library 
     29   USE in_out_manager, ONLY: nit000  ! I/O manager 
     30   USE sbc_phy         ! Catalog of functions for physical/meteorological parameters in the marine boundary layer 
    4031   USE sbcblk_skin_coare ! cool-skin/warm layer scheme (CSWL_ECMWF) !LB 
    4132 
    … …  
    5041   REAL(wp), PARAMETER :: zi0   = 600._wp     ! scale height of the atmospheric boundary layer... 
    5142   REAL(wp), PARAMETER :: Beta0 =  1.2_wp     ! gustiness parameter 
    52  
    53    INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations 
     43   REAL(wp), PARAMETER :: zeta_abs_max = 50._wp 
    5444 
    5545   !!---------------------------------------------------------------------- 
    … …  
    9080 
    9181   SUBROUTINE turb_coare3p6( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 
    92       &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                              & 
    93       &                      Cdn, Chn, Cen,                                              & 
     82      &                      Cd, Ch, Ce, t_zu, q_zu, Ubzu,                               & 
     83      &                      nb_iter, Cdn, Chn, Cen,                                     & ! optional output 
    9484      &                      Qsw, rad_lw, slp, pdT_cs,                                   & ! optionals for cool-skin (and warm-layer) 
    95       &                      pdT_wl, pHz_wl )                                                 ! optionals for warm-layer only 
     85      &                      pdT_wl, pHz_wl )                                              ! optionals for warm-layer only 
    9686      !!---------------------------------------------------------------------- 
    9787      !!                      ***  ROUTINE  turb_coare3p6  *** 
    … …  
    147137      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    148138      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    149       !!    *  U_blk  : bulk wind speed at zu                                 [m/s] 
     139      !!    *  Ubzu  : bulk wind speed at zu                                 [m/s] 
    150140      !! 
    151141      !! 
    … …  
    167157      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    168158      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    169       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s] 
    170       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    171       ! 
     159      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ubzu    ! bulk wind speed at zu                     [m/s] 
     160      ! 
     161      INTEGER , INTENT(in   ), OPTIONAL                     :: nb_iter  ! number of iterations 
     162      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CdN 
     163      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   ChN 
     164      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CeN 
    172165      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2] 
    173166      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2] 
    … …  
    177170      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m] 
    178171      ! 
    179       INTEGER :: j_itt 
     172      INTEGER :: nbit, jit 
    180173      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    181174      ! 
    … …  
    194187      IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P6_INIT(l_use_cs, l_use_wl) 
    195188 
     189      nbit = nb_iter0 
     190      IF( PRESENT(nb_iter) ) nbit = nb_iter 
     191 
    196192      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    197193      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) ) 
    … …  
    211207      ENDIF 
    212208 
    213  
    214209      !! First guess of temperature and humidity at height zu: 
    215210      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions... 
    … …  
    222217      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K) 
    223218 
    224       U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
     219      Ubzu = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
    225220 
    226221      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001) 
    227222      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               " 
    228       u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
    229  
    230       z0     = alfa_charn_3p6(U_zu)*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
     223      u_star = 0.035_wp*Ubzu*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
     224 
     225      z0     = charn_coare3p6(U_zu)*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
    231226      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    232227 
    … …  
    234229      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    235230 
    236       Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd 
    237  
    238       ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd 
    239  
    240       ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN) 
     231      Cd     = MAX( (vkarmn/ztmp0)**2 , Cx_min )    ! first guess of Cd 
     232 
     233      ztmp0 = vkarmn2/LOG(zt/z0t)/Cd 
     234 
     235      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, Ubzu ) ! Bulk Richardson Number (BRN) 
    241236 
    242237      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2): 
    243238      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 ) 
    244       ztmp0 = ztmp0*ztmp2 
    245       zeta_u = (1._wp-ztmp1) * (ztmp0/(1._wp+ztmp2/(-zu/(zi0*0.004_wp*Beta0**3)))) & !  BRN < 0 
    246          &  +     ztmp1   * (ztmp0*(1._wp + 27._wp/9._wp*ztmp2/ztmp0))               !  BRN > 0 
    247       !#LB: should make sure that the "ztmp0" of "27./9.*ztmp2/ztmp0" is "ztmp0*ztmp2" and not "ztmp0==vkarmn*vkarmn/LOG(zt/z0t)/Cd" ! 
     239      zeta_u = (1._wp - ztmp1) *   ztmp0*ztmp2 / (1._wp - ztmp2*zi0*0.004_wp*Beta0**3/zu) & !  BRN < 0 
     240         &  +       ztmp1      * ( ztmp0*ztmp2 + 27._wp/9._wp*ztmp2*ztmp2 )                 !  BRN > 0 
    248241 
    249242      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L 
    250243      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_coare(zeta_u)) 
    251244 
    252       u_star = MAX ( U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
     245      u_star = MAX ( Ubzu*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
    253246      t_star = dt_zu*ztmp0 
    254247      q_star = dq_zu*ztmp0 
    … …  
    269262 
    270263      !! ITERATION BLOCK 
    271       DO j_itt = 1, nb_itt 
    272  
    273          !!Inverse of Monin-Obukov length (1/L) : 
    274          ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Monin-Obukhov length] 
    275          ztmp0 = SIGN( MIN(ABS(ztmp0),200._wp), ztmp0 ) ! (prevents FPE from stupid values from masked region later on...) 
     264      DO jit = 1, nbit 
     265 
     266         !!Inverse of Obukov length (1/L) : 
     267         ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Obukhov length] 
     268         ztmp0 = SIGN( MIN(ABS(ztmp0),200._wp), ztmp0 ) ! 1/L (prevents FPE from stupid values from masked region later on...) 
    276269 
    277270         ztmp1 = u_star*u_star   ! u*^2 
    … …  
    280273         ztmp2 = Beta0*Beta0*ztmp1*(MAX(-zi0*ztmp0/vkarmn,0._wp))**(2._wp/3._wp) ! square of wind gustiness contribution, ztmp2 == Ug^2 
    281274         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0 
    282          U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
    283          ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0. 
     275         Ubzu = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
     276         ! => 0.2 prevents Ubzu to be 0 in stable case when U_zu=0. 
    284277 
    285278         !! Stability parameters: 
    286279         zeta_u = zu*ztmp0 
    287          zeta_u = SIGN( MIN(ABS(zeta_u),50.0_wp), zeta_u ) 
     280         zeta_u = SIGN( MIN(ABS(zeta_u),zeta_abs_max), zeta_u ) 
    288281         IF( .NOT. l_zt_equal_zu ) THEN 
    289282            zeta_t = zt*ztmp0 
    290             zeta_t = SIGN( MIN(ABS(zeta_t),50.0_wp), zeta_t ) 
     283            zeta_t = SIGN( MIN(ABS(zeta_t),zeta_abs_max), zeta_t ) 
    291284         ENDIF 
    292285 
    … …  
    296289         !! Roughness lengthes z0, z0t (z0q = z0t) : 
    297290         ztmp2 = u_star/vkarmn*LOG(10./z0)                                 ! Neutral wind speed at 10m 
    298          z0    = alfa_charn_3p6(ztmp2)*ztmp1/grav + 0.11_wp*znu_a/u_star   ! Roughness length (eq.6) [ ztmp1==u*^2 ] 
     291         z0    = charn_coare3p6(ztmp2)*ztmp1/grav + 0.11_wp*znu_a/u_star   ! Roughness length (eq.6) [ ztmp1==u*^2 ] 
    299292         z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    300293 
    … …  
    309302         t_star = dt_zu*ztmp1 
    310303         q_star = dq_zu*ztmp1 
    311          u_star = MAX( U_blk*vkarmn/(LOG(zu) - LOG(z0) - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
     304         u_star = MAX( Ubzu*vkarmn/(LOG(zu) - LOG(z0) - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
    312305 
    313306         IF( .NOT. l_zt_equal_zu ) THEN 
    … …  
    318311         ENDIF 
    319312 
    320  
    321313         IF( l_use_cs ) THEN 
    322314            !! Cool-skin contribution 
    323315 
    324             CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     316            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, & 
    325317               &                   ztmp1, zeta_u,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> zeta_u 
    326318 
    … …  
    330322            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1) 
    331323            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) 
    332  
    333324         ENDIF 
    334325 
    335326         IF( l_use_wl ) THEN 
    336327            !! Warm-layer contribution 
    337             CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     328            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, & 
    338329               &                   ztmp1, zeta_u)  ! Qnsol -> ztmp1 / Tau -> zeta_u 
    339330            !! In WL_COARE or , Tau_ac and Qnt_ac must be updated at the final itteration step => add a flag to do this! 
    340             CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nb_itt,j_itt) ) 
     331            CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nbit,jit) ) 
    341332 
    342333            !! Updating T_s and q_s !!! 
    … …  
    351342         ENDIF 
    352343 
    353       END DO !DO j_itt = 1, nb_itt 
     344      END DO !DO jit = 1, nbit 
    354345 
    355346      ! compute transfer coefficients at zu : 
    356       ztmp0 = u_star/U_blk 
    357       Cd   = ztmp0*ztmp0 
    358       Ch   = ztmp0*t_star/dt_zu 
    359       Ce   = ztmp0*q_star/dq_zu 
    360  
    361       ztmp1 = zu + z0 
    362       Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 )) 
    363       Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t)) 
    364       Cen = Chn 
     347      ztmp0 = u_star/Ubzu 
     348      Cd   = MAX( ztmp0*ztmp0        , Cx_min ) 
     349      Ch   = MAX( ztmp0*t_star/dt_zu , Cx_min ) 
     350      Ce   = MAX( ztmp0*q_star/dq_zu , Cx_min ) 
    365351 
    366352      IF( .NOT. l_zt_equal_zu ) DEALLOCATE( zeta_t ) 
     353 
     354      IF(PRESENT(Cdn)) Cdn = MAX( vkarmn2 / (LOG(zu/z0 )*LOG(zu/z0 )) , Cx_min ) 
     355      IF(PRESENT(Chn)) Chn = MAX( vkarmn2 / (LOG(zu/z0t)*LOG(zu/z0t)) , Cx_min ) 
     356      IF(PRESENT(Cen)) Cen = MAX( vkarmn2 / (LOG(zu/z0t)*LOG(zu/z0t)) , Cx_min ) 
    367357 
    368358      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs 
    … …  
    375365 
    376366 
    377    FUNCTION alfa_charn_3p6( pwnd ) 
     367   FUNCTION charn_coare3p6( pwnd ) 
    378368      !!------------------------------------------------------------------- 
    379369      !! Computes the Charnock parameter as a function of the Neutral wind speed at 10m 
    … …  
    383373      !! Author: L. Brodeau, July 2019 / AeroBulk  (https://github.com/brodeau/aerobulk/) 
    384374      !!------------------------------------------------------------------- 
    385       REAL(wp), DIMENSION(jpi,jpj) :: alfa_charn_3p6 
     375      REAL(wp), DIMENSION(jpi,jpj) :: charn_coare3p6 
    386376      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd   ! neutral wind speed at 10m 
    387377      ! 
    388378      REAL(wp), PARAMETER :: charn0_max = 0.028  !: value above which the Charnock parameter levels off for winds > 18 m/s 
    389379      !!------------------------------------------------------------------- 
    390       alfa_charn_3p6 = MAX( MIN( 0.0017_wp*pwnd - 0.005_wp , charn0_max) , 0._wp ) 
    391       !! 
    392    END FUNCTION alfa_charn_3p6 
    393  
    394    FUNCTION alfa_charn_3p6_wave( pus, pwsh, pwps ) 
     380      charn_coare3p6 = MAX( MIN( 0.0017_wp*pwnd - 0.005_wp , charn0_max) , 0._wp ) 
     381      !! 
     382   END FUNCTION charn_coare3p6 
     383 
     384   FUNCTION charn_coare3p6_wave( pus, pwsh, pwps ) 
    395385      !!------------------------------------------------------------------- 
    396386      !! Computes the Charnock parameter as a function of wave information and u* 
    … …  
    400390      !! Author: L. Brodeau, October 2019 / AeroBulk  (https://github.com/brodeau/aerobulk/) 
    401391      !!------------------------------------------------------------------- 
    402       REAL(wp), DIMENSION(jpi,jpj) :: alfa_charn_3p6_wave 
     392      REAL(wp), DIMENSION(jpi,jpj) :: charn_coare3p6_wave 
    403393      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus   ! friction velocity             [m/s] 
    404394      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwsh  ! significant wave height       [m] 
    405395      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwps  ! phase speed of dominant waves [m/s] 
    406396      !!------------------------------------------------------------------- 
    407       alfa_charn_3p6_wave = ( pwsh*0.2_wp*(pus/pwps)**2.2_wp ) * grav/(pus*pus) 
    408       !! 
    409    END FUNCTION alfa_charn_3p6_wave 
     397      charn_coare3p6_wave = ( pwsh*0.2_wp*(pus/pwps)**2.2_wp ) * grav/(pus*pus) 
     398      !! 
     399   END FUNCTION charn_coare3p6_wave 
    410400 
    411401 
    … …  
    429419      REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 
    430420      !!---------------------------------------------------------------------------------- 
    431       ! 
    432421      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    433       ! 
    434       zta = pzeta(ji,jj) 
    435       ! 
    436       zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
    437       ! 
    438       zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
    439          & - 2.*ATAN(zphi_m) + 0.5*rpi 
    440       ! 
    441       zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
    442       ! 
    443       zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    444          &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    445       ! 
    446       zf = zta*zta 
    447       zf = zf/(1. + zf) 
    448       zc = MIN(50._wp, 0.35_wp*zta) 
    449       zstab = 0.5 + SIGN(0.5_wp, zta) 
    450       ! 
    451       psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
    452          &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
    453          &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     " 
    454       ! 
     422            ! 
     423            zta = pzeta(ji,jj) 
     424            ! 
     425            zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
     426            ! 
     427            zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
     428               & - 2.*ATAN(zphi_m) + 0.5*rpi 
     429            ! 
     430            zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
     431            ! 
     432            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     433               &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     434            ! 
     435            zf = zta*zta 
     436            zf = zf/(1. + zf) 
     437            zc = MIN(50._wp, 0.35_wp*zta) 
     438            zstab = 0.5 + SIGN(0.5_wp, zta) 
     439            ! 
     440            psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
     441               &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
     442               &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )  !     " 
    455443      END_2D 
    456       ! 
    457444   END FUNCTION psi_m_coare 
    458445 
    … …  
    474461      !!         (https://github.com/brodeau/aerobulk/) 
    475462      !!---------------------------------------------------------------- 
    476       !! 
    477463      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare 
    478464      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
    … …  
    480466      INTEGER  ::   ji, jj     ! dummy loop indices 
    481467      REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 
    482       ! 
     468      !!---------------------------------------------------------------- 
    483469      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    484       ! 
    485       zta = pzeta(ji,jj) 
    486       ! 
    487       zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
    488       ! 
    489       zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
    490       ! 
    491       zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
    492       ! 
    493       zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    494          &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    495       ! 
    496       zf = zta*zta 
    497       zf = zf/(1. + zf) 
    498       zc = MIN(50._wp,0.35_wp*zta) 
    499       zstab = 0.5 + SIGN(0.5_wp, zta) 
    500       ! 
    501       psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
    502          &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
    503          &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
    504       ! 
     470            ! 
     471            zta = pzeta(ji,jj) 
     472            ! 
     473            zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
     474            ! 
     475            zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
     476            ! 
     477            zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
     478            ! 
     479            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     480               &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     481            ! 
     482            zf = zta*zta 
     483            zf = zf/(1. + zf) 
     484            zc = MIN(50._wp,0.35_wp*zta) 
     485            zstab = 0.5 + SIGN(0.5_wp, zta) 
     486            ! 
     487            psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
     488               &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
     489               &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
    505490      END_2D 
    506       ! 
    507491   END FUNCTION psi_h_coare 
    508492 

  • NEMO/trunk/src/OCE/SBC/sbcblk_algo_ecmwf.F90

    r14007 r14072  
    55   !!   * bulk transfer coefficients C_D, C_E and C_H 
    66   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed 
    7    !!   * the effective bulk wind speed at 10m U_blk 
     7   !!   * the effective bulk wind speed at 10m Ubzu 
    88   !!   => all these are used in bulk formulas in sbcblk.F90 
    99   !! 
    … …  
    1717   !!---------------------------------------------------------------------- 
    1818   !! History :  4.0  !  2016-02  (L.Brodeau)   Original code 
    19    !!            4.2  !  2020-12  (G. Madec, E. Clementi) Charnock coeff from wave model 
     19   !!            4.2  !  2020-12  (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 
    2020   !!---------------------------------------------------------------------- 
    2121 
    … …  
    2525   !!                   returns the effective bulk wind speed at 10m 
    2626   !!---------------------------------------------------------------------- 
    27    USE oce             ! ocean dynamics and tracers 
    2827   USE dom_oce         ! ocean space and time domain 
    2928   USE phycst          ! physical constants 
    30    USE iom             ! I/O manager library 
    31    USE lib_mpp         ! distribued memory computing library 
    32    USE in_out_manager  ! I/O manager 
    33    USE prtctl          ! Print control 
    34    USE sbcwave, ONLY   : charn ! wave module 
    35 #if defined key_si3 || defined key_cice 
    36    USE sbc_ice         ! Surface boundary condition: ice fields 
    37 #endif 
    38    USE lib_fortran     ! to use key_nosignedzero 
    39  
    40    USE sbc_oce         ! Surface boundary condition: ocean fields 
    41    USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
     29   USE lib_mpp,        ONLY: ctl_stop         ! distribued memory computing library 
     30   USE in_out_manager, ONLY: nit000  ! I/O manager 
     31   USE sbc_phy         ! Catalog of functions for physical/meteorological parameters in the marine boundary layer 
    4232   USE sbcblk_skin_ecmwf ! cool-skin/warm layer scheme !LB 
    4333 
    … …  
    4636 
    4737   PUBLIC :: SBCBLK_ALGO_ECMWF_INIT, TURB_ECMWF 
    48    !! * Substitutions 
    49 #  include "do_loop_substitute.h90" 
    5038 
    5139   !! ECMWF own values for given constants, taken form IFS documentation... 
    52    REAL(wp), PARAMETER ::   charn0 = 0.018    ! Charnock constant (pretty high value here !!! 
     40   REAL(wp), PARAMETER, PUBLIC :: charn0_ecmwf = 0.018_wp    ! Charnock constant (pretty high value here !!! 
    5341   !                                          !    =>  Usually 0.011 for moderate winds) 
    5442   REAL(wp), PARAMETER ::   zi0     = 1000.   ! scale height of the atmospheric boundary layer...1 
    … …  
    5846   REAL(wp), PARAMETER ::   alpha_Q = 0.62    ! 
    5947 
    60    INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations 
     48   !! * Substitutions 
     49#  include "do_loop_substitute.h90" 
    6150 
    6251   !!---------------------------------------------------------------------- 
    … …  
    9584 
    9685   SUBROUTINE turb_ecmwf( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 
    97       &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                           & 
    98       &                      Cdn, Chn, Cen,                                           & 
     86      &                      Cd, Ch, Ce, t_zu, q_zu, Ubzu,                            & 
     87      &                      nb_iter, Cdn, Chn, Cen,                                           & ! optional output 
    9988      &                      Qsw, rad_lw, slp, pdT_cs,                                & ! optionals for cool-skin (and warm-layer) 
    10089      &                      pdT_wl, pHz_wl )                                           ! optionals for warm-layer only 
    … …  
    152141      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    153142      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    154       !!    *  U_blk  : bulk wind speed at zu                                 [m/s] 
     143      !!    *  Ubzu   : bulk wind speed at zu                                 [m/s] 
    155144      !! 
    156145      !! 
    … …  
    172161      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    173162      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    174       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s] 
    175       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    176       ! 
     163      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ubzu    ! bulk wind speed at zu                     [m/s] 
     164      ! 
     165      INTEGER , INTENT(in   ), OPTIONAL                     :: nb_iter  ! number of iterations 
     166      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CdN 
     167      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   ChN 
     168      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CeN 
    177169      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2] 
    178170      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2] 
    … …  
    182174      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m] 
    183175      ! 
    184       INTEGER :: j_itt 
     176      INTEGER :: nbit, jit 
    185177      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    186178      ! 
    … …  
    198190      !!---------------------------------------------------------------------------------- 
    199191      IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl) 
     192 
     193      nbit = nb_iter0 
     194      IF( PRESENT(nb_iter) ) nbit = nb_iter 
    200195 
    201196      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    … …  
    228223      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K) 
    229224 
    230       U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
     225      Ubzu = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
    231226 
    232227      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001) 
    233228      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               " 
    234       u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
    235  
    236       IF (ln_charn)  THEN          !  Charnock value if wave coupling 
    237          z0     = charn*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
    238       ELSE 
    239          z0     = charn0*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
    240       ENDIF 
    241  
     229      u_star = 0.035_wp*Ubzu*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
     230 
     231      z0     = charn0_ecmwf*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
    242232      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    243233 
    … …  
    245235      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    246236 
    247       Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd 
    248  
    249       ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd 
    250  
    251       ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN) 
     237      Cd     = MAX( (vkarmn/ztmp0)**2 , Cx_min )   ! first guess of Cd 
     238 
     239      ztmp0 = vkarmn2/LOG(zt/z0t)/Cd 
     240 
     241      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, Ubzu ) ! Bulk Richardson Number (BRN) 
    252242 
    253243      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2): 
    254244      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 ) 
    255       func_m = ztmp0*ztmp2 ! temporary array !! 
    256       func_h = (1._wp-ztmp1) * (func_m/(1._wp+ztmp2/(-zu/(zi0*0.004_wp*Beta0**3)))) & !  BRN < 0 ! temporary array !!! func_h == zeta_u 
    257          &  +     ztmp1   * (func_m*(1._wp + 27._wp/9._wp*ztmp2/func_m))              !  BRN > 0 
    258       !#LB: should make sure that the "func_m" of "27./9.*ztmp2/func_m" is "ztmp0*ztmp2" and not "ztmp0==vkarmn*vkarmn/LOG(zt/z0t)/Cd" ! 
     245      func_h = (1._wp - ztmp1) *   ztmp0*ztmp2 / (1._wp - ztmp2*zi0*0.004_wp*Beta0**3/zu) & !  BRN < 0 
     246         &  +       ztmp1      * ( ztmp0*ztmp2 + 27._wp/9._wp*ztmp2*ztmp2 )                 !  BRN > 0 
    259247 
    260248      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L 
    261249      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_ecmwf(func_h)) 
    262250 
    263       u_star = MAX ( U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
     251      u_star = MAX ( Ubzu*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
    264252      t_star = dt_zu*ztmp0 
    265253      q_star = dq_zu*ztmp0 
    … …  
    282270 
    283271 
    284       !! First guess of inverse of Monin-Obukov length (1/L) : 
     272      !! First guess of inverse of Obukov length (1/L) : 
    285273      Linv = One_on_L( t_zu, q_zu, u_star, t_star, q_star ) 
    286274 
    287       !! Functions such as  u* = U_blk*vkarmn/func_m 
     275      !! Functions such as  u* = Ubzu*vkarmn/func_m 
    288276      ztmp0 = zu*Linv 
    289277      func_m = LOG(zu) - LOG(z0)  - psi_m_ecmwf(ztmp0) + psi_m_ecmwf( z0*Linv) 
    … …  
    291279 
    292280      !! ITERATION BLOCK 
    293       DO j_itt = 1, nb_itt 
     281      DO jit = 1, nbit 
    294282 
    295283         !! Bulk Richardson Number at z=zu (Eq. 3.25) 
    296          ztmp0 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN) 
    297  
    298          !! New estimate of the inverse of the Monin-Obukhon length (Linv == zeta/zu) : 
     284         ztmp0 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, Ubzu ) ! Bulk Richardson Number (BRN) 
     285 
     286         !! New estimate of the inverse of the Obukhon length (Linv == zeta/zu) : 
    299287         Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3.2.3, IFS doc - Cy40r1 
    300288         !! Note: it is slightly different that the L we would get with the usual 
    … …  
    305293 
    306294         !! Need to update roughness lengthes: 
    307          u_star = U_blk*vkarmn/func_m 
     295         u_star = Ubzu*vkarmn/func_m 
    308296         ztmp2  = u_star*u_star 
    309297         ztmp1  = znu_a/u_star 
    310          IF (ln_charn) THEN     ! Charnock value if wave coupling 
    311             z0  = MIN( ABS( alpha_M*ztmp1 + charn*ztmp2/grav ) , 0.001_wp)          
    312          ELSE 
    313             z0     = MIN( ABS( alpha_M*ztmp1 + charn0*ztmp2/grav ) , 0.001_wp) 
    314          ENDIF 
    315          z0t    = MIN( ABS( alpha_H*ztmp1                     ) , 0.001_wp)   ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1 
    316          z0q    = MIN( ABS( alpha_Q*ztmp1                     ) , 0.001_wp) 
     298         z0     = MIN( ABS( alpha_M*ztmp1 + charn0_ecmwf*ztmp2/grav ) , 0.001_wp) 
     299         z0t    = MIN( ABS( alpha_H*ztmp1                           ) , 0.001_wp)   ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1 
     300         z0q    = MIN( ABS( alpha_Q*ztmp1                           ) , 0.001_wp) 
    317301 
    318302         !! Update wind at zu with convection-related wind gustiness in unstable conditions (Chap. 3.2, IFS doc - Cy40r1, Eq.3.17 and Eq.3.18 + Eq.3.8) 
    319303         ztmp2 = Beta0*Beta0*ztmp2*(MAX(-zi0*Linv/vkarmn,0._wp))**(2._wp/3._wp) ! square of wind gustiness contribution  (combining Eq. 3.8 and 3.18, hap.3, IFS doc - Cy31r1) 
    320304         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0 
    321          U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
    322          ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0. 
     305         Ubzu = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
     306         ! => 0.2 prevents Ubzu to be 0 in stable case when U_zu=0. 
    323307 
    324308 
    … …  
    356340            !! Cool-skin contribution 
    357341 
    358             CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     342            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, & 
    359343               &                   ztmp1, ztmp0,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp0 
    360344 
    … …  
    369353         IF( l_use_wl ) THEN 
    370354            !! Warm-layer contribution 
    371             CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     355            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, & 
    372356               &                   ztmp1, ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp2 
    373357            CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst ) 
    … …  
    383367         ENDIF 
    384368 
    385       END DO !DO j_itt = 1, nb_itt 
    386  
    387       Cd = vkarmn*vkarmn/(func_m*func_m) 
    388       Ch = vkarmn*vkarmn/(func_m*func_h) 
    389       ztmp2 = log(zu/z0q) - psi_h_ecmwf(zu*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q 
    390       Ce = vkarmn*vkarmn/(func_m*ztmp2) 
    391  
    392       Cdn = vkarmn*vkarmn / (log(zu/z0 )*log(zu/z0 )) 
    393       Chn = vkarmn*vkarmn / (log(zu/z0t)*log(zu/z0t)) 
    394       Cen = vkarmn*vkarmn / (log(zu/z0q)*log(zu/z0q)) 
     369      END DO !DO jit = 1, nbit 
     370 
     371      Cd = MAX( vkarmn2/(func_m*func_m) , Cx_min ) 
     372      Ch = MAX( vkarmn2/(func_m*func_h) , Cx_min ) 
     373      ztmp2 = LOG(zu/z0q) - psi_h_ecmwf(zu*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q 
     374      Ce = MAX( vkarmn2/(func_m*ztmp2)  , Cx_min ) 
     375 
     376      IF(PRESENT(Cdn)) Cdn = MAX( vkarmn2 / (LOG(zu/z0 )*LOG(zu/z0 )) , Cx_min ) 
     377      IF(PRESENT(Chn)) Chn = MAX( vkarmn2 / (LOG(zu/z0t)*LOG(zu/z0t)) , Cx_min ) 
     378      IF(PRESENT(Cen)) Cen = MAX( vkarmn2 / (LOG(zu/z0q)*LOG(zu/z0q)) , Cx_min ) 
    395379 
    396380      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs 
    … …  
    418402      ! 
    419403      INTEGER  ::   ji, jj    ! dummy loop indices 
    420       REAL(wp) :: zzeta, zx, ztmp, psi_unst, psi_stab, stab 
    421       !!---------------------------------------------------------------------------------- 
     404      REAL(wp) :: zta, zx2, zx, ztmp, zpsi_unst, zpsi_stab, zstab, zc 
     405      !!---------------------------------------------------------------------------------- 
     406      zc = 5._wp/0.35_wp 
    422407      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    423       ! 
    424       zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): 
    425       ! 
    426       ! Unstable (Paulson 1970): 
    427       !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
    428       zx = SQRT(ABS(1._wp - 16._wp*zzeta)) 
    429       ztmp = 1._wp + SQRT(zx) 
    430       ztmp = ztmp*ztmp 
    431       psi_unst = LOG( 0.125_wp*ztmp*(1._wp + zx) )   & 
    432          &       -2._wp*ATAN( SQRT(zx) ) + 0.5_wp*rpi 
    433       ! 
    434       ! Unstable: 
    435       ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
    436       psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & 
    437          &       - zzeta - 2._wp/3._wp*5._wp/0.35_wp 
    438       ! 
    439       ! Combining: 
    440       stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
    441       ! 
    442       psi_m_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable 
    443          &                +      stab  * psi_stab      ! (zzeta > 0) Stable 
    444       ! 
     408            ! 
     409            zta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): 
     410 
     411            ! *** Unstable (Paulson 1970)    [eq.3.20, Chap.3, p.33, IFS doc - Cy31r1] : 
     412            zx2 = SQRT( ABS(1._wp - 16._wp*zta) )  ! (1 - 16z)^0.5 
     413            zx  = SQRT(zx2)                          ! (1 - 16z)^0.25 
     414            ztmp = 1._wp + zx 
     415            zpsi_unst = LOG( 0.125_wp*ztmp*ztmp*(1._wp + zx2) ) - 2._wp*ATAN( zx ) + 0.5_wp*rpi 
     416 
     417            ! *** Stable                   [eq.3.22, Chap.3, p.33, IFS doc - Cy31r1] : 
     418            zpsi_stab = -2._wp/3._wp*(zta - zc)*EXP(-0.35_wp*zta) & 
     419               &       - zta - 2._wp/3._wp*zc 
     420            ! 
     421            zstab = 0.5_wp + SIGN(0.5_wp, zta) ! zta > 0 => zstab = 1 
     422            ! 
     423            psi_m_ecmwf(ji,jj) =         zstab  * zpsi_stab &  ! (zta > 0) Stable 
     424               &              + (1._wp - zstab) * zpsi_unst    ! (zta < 0) Unstable 
     425            ! 
    445426      END_2D 
    446427   END FUNCTION psi_m_ecmwf 
    … …  
    462443      ! 
    463444      INTEGER  ::   ji, jj     ! dummy loop indices 
    464       REAL(wp) ::  zzeta, zx, psi_unst, psi_stab, stab 
    465       !!---------------------------------------------------------------------------------- 
     445      REAL(wp) ::  zta, zx2, zpsi_unst, zpsi_stab, zstab, zc 
     446      !!---------------------------------------------------------------------------------- 
     447      zc = 5._wp/0.35_wp 
    466448      ! 
    467449      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    468       ! 
    469       zzeta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!): 
    470       ! 
    471       zx  = ABS(1._wp - 16._wp*zzeta)**.25        ! this is actually (1/phi_m)**2  !!! 
    472       !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1 
    473       ! Unstable (Paulson 1970) : 
    474       psi_unst = 2._wp*LOG(0.5_wp*(1._wp + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
    475       ! 
    476       ! Stable: 
    477       psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
    478          &       - ABS(1._wp + 2._wp/3._wp*zzeta)**1.5_wp - 2._wp/3._wp*5._wp/0.35_wp + 1._wp 
    479       ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution... 
    480       ! 
    481       stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
    482       ! 
    483       ! 
    484       psi_h_ecmwf(ji,jj) = (1._wp - stab) * psi_unst &   ! (zzeta < 0) Unstable 
    485          &                +    stab    * psi_stab        ! (zzeta > 0) Stable 
    486       ! 
     450            ! 
     451            zta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!): 
     452            ! 
     453            ! *** Unstable (Paulson 1970)   [eq.3.20, Chap.3, p.33, IFS doc - Cy31r1] : 
     454            zx2 = SQRT( ABS(1._wp - 16._wp*zta) )  ! (1 -16z)^0.5 
     455            zpsi_unst = 2._wp*LOG( 0.5_wp*(1._wp + zx2) ) 
     456            ! 
     457            ! *** Stable [eq.3.22, Chap.3, p.33, IFS doc - Cy31r1] : 
     458            zpsi_stab = -2._wp/3._wp*(zta - zc)*EXP(-0.35_wp*zta) & 
     459               &       - ABS(1._wp + 2._wp/3._wp*zta)**1.5_wp - 2._wp/3._wp*zc + 1._wp 
     460            ! 
     461            ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution... 
     462            ! 
     463            zstab = 0.5_wp + SIGN(0.5_wp, zta) ! zta > 0 => zstab = 1 
     464            ! 
     465            psi_h_ecmwf(ji,jj) =         zstab  * zpsi_stab &  ! (zta > 0) Stable 
     466               &              + (1._wp - zstab) * zpsi_unst    ! (zta < 0) Unstable 
     467            ! 
    487468      END_2D 
    488469   END FUNCTION psi_h_ecmwf 

  • NEMO/trunk/src/OCE/SBC/sbcblk_algo_ncar.F90

    r13460 r14072  
    55   !!   * bulk transfer coefficients C_D, C_E and C_H 
    66   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed 
    7    !!   * the effective bulk wind speed at 10m U_blk 
     7   !!   * the effective bulk wind speed at 10m Ubzu 
    88   !!   => all these are used in bulk formulas in sbcblk.F90 
    99   !! 
    … …  
    1616   !!===================================================================== 
    1717   !! History :  3.6  !  2016-02  (L.Brodeau) successor of old turb_ncar of former sbcblk_core.F90 
     18   !!            4.2  !  2020-12  (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 
    1819   !!---------------------------------------------------------------------- 
    1920 
    … …  
    2324   !!                   returns the effective bulk wind speed at 10m 
    2425   !!---------------------------------------------------------------------- 
    25    USE oce             ! ocean dynamics and tracers 
    2626   USE dom_oce         ! ocean space and time domain 
     27   USE sbc_oce, ONLY: ln_cdgw 
     28   USE sbcwave, ONLY: cdn_wave ! wave module 
    2729   USE phycst          ! physical constants 
    28    USE sbc_oce         ! Surface boundary condition: ocean fields 
    29    USE sbcwave, ONLY   :  cdn_wave ! wave module 
    30 #if defined key_si3 || defined key_cice 
    31    USE sbc_ice         ! Surface boundary condition: ice fields 
    32 #endif 
    33    ! 
    34    USE iom             ! I/O manager library 
    35    USE lib_mpp         ! distribued memory computing library 
    36    USE in_out_manager  ! I/O manager 
    37    USE prtctl          ! Print control 
    38    USE lib_fortran     ! to use key_nosignedzero 
    39  
    40    USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
     30   USE sbc_phy         ! Catalog of functions for physical/meteorological parameters in the marine boundary layer 
    4131 
    4232   IMPLICIT NONE 
    … …  
    4535   PUBLIC :: TURB_NCAR   ! called by sbcblk.F90 
    4636 
    47    INTEGER , PARAMETER ::   nb_itt = 5        ! number of itterations 
    4837   !! * Substitutions 
    4938#  include "do_loop_substitute.h90" 
    … …  
    5241CONTAINS 
    5342 
    54    SUBROUTINE turb_ncar( zt, zu, sst, t_zt, ssq, q_zt, U_zu, & 
    55       &                  Cd, Ch, Ce, t_zu, q_zu, U_blk,      & 
    56       &                  Cdn, Chn, Cen                       ) 
     43   SUBROUTINE turb_ncar(    zt, zu, sst, t_zt, ssq, q_zt, U_zu, & 
     44      &                     Cd, Ch, Ce, t_zu, q_zu, Ubzu,       & 
     45      &                     nb_iter, CdN, ChN, CeN               ) 
    5746      !!---------------------------------------------------------------------------------- 
    5847      !!                      ***  ROUTINE  turb_ncar  *** 
    … …  
    6150      !!                fluxes according to Large & Yeager (2004) and Large & Yeager (2008) 
    6251      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu 
    63       !!                Returns the effective bulk wind speed at 10m to be used in the bulk formulas 
    64       !! 
     52      !!                Returns the effective bulk wind speed at zu to be used in the bulk formulas 
    6553      !! 
    6654      !! INPUT : 
    … …  
    8270      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    8371      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    84       !!    *  U_blk  : bulk wind speed at zu                                 [m/s] 
    85       !! 
     72      !!    *  Ubzu   : bulk wind speed at zu                                 [m/s] 
     73      !! 
     74      !! OPTIONAL OUTPUT: 
     75      !! ---------------- 
     76      !!    * CdN      : neutral-stability drag coefficient 
     77      !!    * ChN      : neutral-stability sensible heat coefficient 
     78      !!    * CeN      : neutral-stability evaporation coefficient 
    8679      !! 
    8780      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    … …  
    9992      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    10093      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    101       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s] 
    102       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    103       ! 
    104       INTEGER :: j_itt 
     94      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ubzu    ! bulk wind speed at zu                     [m/s] 
     95      ! 
     96      INTEGER , INTENT(in   ), OPTIONAL                     :: nb_iter  ! number of iterations 
     97      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CdN 
     98      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   ChN 
     99      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CeN 
     100      ! 
     101      INTEGER :: nbit, jit                    ! iterations... 
    105102      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    106103      ! 
    107       REAL(wp), DIMENSION(jpi,jpj) ::   Cx_n10        ! 10m neutral latent/sensible coefficient 
    108       REAL(wp), DIMENSION(jpi,jpj) ::   sqrt_Cd_n10   ! root square of Cd_n10 
     104      REAL(wp), DIMENSION(jpi,jpj) ::   zCdN, zCeN, zChN        ! 10m neutral latent/sensible coefficient 
     105      REAL(wp), DIMENSION(jpi,jpj) ::   zsqrt_Cd, zsqrt_CdN   ! root square of Cd and Cd_neutral 
    109106      REAL(wp), DIMENSION(jpi,jpj) ::   zeta_u        ! stability parameter at height zu 
    110       REAL(wp), DIMENSION(jpi,jpj) ::   zpsi_h_u 
    111107      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp0, ztmp1, ztmp2 
    112       REAL(wp), DIMENSION(jpi,jpj) ::   stab          ! stability test integer 
    113       !!---------------------------------------------------------------------------------- 
     108      !!---------------------------------------------------------------------------------- 
     109      nbit = nb_iter0 
     110      IF( PRESENT(nb_iter) ) nbit = nb_iter 
     111 
    114112      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    115113 
    116       U_blk = MAX( 0.5_wp , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
     114      Ubzu = MAX( 0.5_wp , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
    117115 
    118116      !! First guess of stability: 
    119117      ztmp0 = virt_temp(t_zt, q_zt) - virt_temp(sst, ssq) ! air-sea difference of virtual pot. temp. at zt 
    120       stab  = 0.5_wp + sign(0.5_wp,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable 
     118      ztmp1 = 0.5_wp + SIGN(0.5_wp,ztmp0)                 ! ztmp1 = 1 if dTv > 0  => STABLE, 0 if unstable 
    121119 
    122120      !! Neutral coefficients at 10m: 
    123121      IF( ln_cdgw ) THEN      ! wave drag case 
    124122         cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) 
    125          ztmp0   (:,:) = cdn_wave(:,:) 
     123         zCdN   (:,:) = cdn_wave(:,:) 
    126124      ELSE 
    127       ztmp0 = cd_neutral_10m( U_blk ) 
     125      zCdN = cd_n10_ncar( Ubzu ) 
    128126      ENDIF 
    129127 
    130       sqrt_Cd_n10 = SQRT( ztmp0 ) 
     128      zsqrt_CdN = SQRT( zCdN ) 
    131129 
    132130      !! Initializing transf. coeff. with their first guess neutral equivalents : 
    133       Cd = ztmp0 
    134       Ce = 1.e-3_wp*( 34.6_wp * sqrt_Cd_n10 ) 
    135       Ch = 1.e-3_wp*sqrt_Cd_n10*(18._wp*stab + 32.7_wp*(1._wp - stab)) 
    136       stab = sqrt_Cd_n10   ! Temporaty array !!! stab == SQRT(Cd) 
    137   
     131      Cd = zCdN 
     132      Ce = ce_n10_ncar( zsqrt_CdN ) 
     133      Ch = ch_n10_ncar( zsqrt_CdN , ztmp1 )   ! ztmp1 is stability (1/0) 
     134      zsqrt_Cd = zsqrt_CdN 
     135 
    138136      IF( ln_cdgw ) THEN 
    139    Cen = Ce 
    140    Chn = Ch 
     137         zCeN = Ce 
     138         zChN = Ch 
    141139      ENDIF 
    142140 
    143       !! First guess of temperature and humidity at height zu: 
     141      !! Initializing values at z_u with z_t values: 
    144142      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions... 
    145143      q_zu = MAX( q_zt , 1.e-6_wp )   !               " 
    146144 
     145 
    147146      !! ITERATION BLOCK 
    148       DO j_itt = 1, nb_itt 
     147      DO jit = 1, nbit 
    149148         ! 
    150149         ztmp1 = t_zu - sst   ! Updating air/sea differences 
    151150         ztmp2 = q_zu - ssq 
    152151 
    153          ! Updating turbulent scales :   (L&Y 2004 eq. (7)) 
    154          ztmp0 = stab*U_blk       ! u*       (stab == SQRT(Cd)) 
    155          ztmp1 = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd)) 
    156          ztmp2 = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd)) 
    157  
    158          ! Estimate the inverse of Monin-Obukov length (1/L) at height zu: 
     152         ! Updating turbulent scales :   (L&Y 2004 Eq. (7)) 
     153         ztmp0 = zsqrt_Cd*Ubzu       ! u* 
     154         ztmp1 = Ch/zsqrt_Cd*ztmp1    ! theta* 
     155         ztmp2 = Ce/zsqrt_Cd*ztmp2    ! q* 
     156 
     157         ! Estimate the inverse of Obukov length (1/L) at height zu: 
    159158         ztmp0 = One_on_L( t_zu, q_zu, ztmp0, ztmp1, ztmp2 ) 
    160           
     159 
    161160         !! Stability parameters : 
    162161         zeta_u   = zu*ztmp0 
    163          zeta_u = sign( min(abs(zeta_u),10._wp), zeta_u ) 
    164          zpsi_h_u = psi_h( zeta_u ) 
    165  
    166          !! Shifting temperature and humidity at zu (L&Y 2004 eq. (9b-9c)) 
     162         zeta_u   = sign( min(abs(zeta_u),10._wp), zeta_u ) 
     163 
     164         !! Shifting temperature and humidity at zu (L&Y 2004 Eq. (9b-9c)) 
    167165         IF( .NOT. l_zt_equal_zu ) THEN 
    168             !! Array 'stab' is free for the moment so using it to store 'zeta_t' 
    169             stab = zt*ztmp0 
    170             stab = SIGN( MIN(ABS(stab),10._wp), stab )  ! Temporaty array stab == zeta_t !!! 
    171             stab = LOG(zt/zu) + zpsi_h_u - psi_h(stab)                   ! stab just used as temp array again! 
    172             t_zu = t_zt - ztmp1/vkarmn*stab    ! ztmp1 is still theta*  L&Y 2004 eq.(9b) 
    173             q_zu = q_zt - ztmp2/vkarmn*stab    ! ztmp2 is still q*      L&Y 2004 eq.(9c) 
    174             q_zu = max(0._wp, q_zu) 
    175          ENDIF 
    176  
    177          ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
     166            ztmp0 = zt*ztmp0 ! zeta_t ! 
     167            ztmp0 = SIGN( MIN(ABS(ztmp0),10._wp), ztmp0 )  ! Temporaty array ztmp0 == zeta_t !!! 
     168            ztmp0 = LOG(zt/zu) + psi_h_ncar(zeta_u) - psi_h_ncar(ztmp0)                   ! ztmp0 just used as temp array again! 
     169            t_zu = t_zt - ztmp1/vkarmn*ztmp0    ! ztmp1 is still theta*  L&Y 2004 Eq. (9b) 
     170            !! 
     171            q_zu = q_zt - ztmp2/vkarmn*ztmp0    ! ztmp2 is still q*      L&Y 2004 Eq. (9c) 
     172            q_zu = MAX(0._wp, q_zu) 
     173         END IF 
     174 
     175         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 Eq. 9a)... 
    178176         !   In very rare low-wind conditions, the old way of estimating the 
    179177         !   neutral wind speed at 10m leads to a negative value that causes the code 
    180178         !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
    181          ztmp2 = psi_m(zeta_u) 
     179         ztmp2 = psi_m_ncar(zeta_u) 
    182180         IF( ln_cdgw ) THEN      ! surface wave case 
    183             stab = vkarmn / ( vkarmn / sqrt_Cd_n10 - ztmp2 )  ! (stab == SQRT(Cd)) 
    184             Cd   = stab * stab 
    185             ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
    186             ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd)) 
    187             ztmp1 = 1._wp + Chn * ztmp0      
    188             Ch    = Chn * ztmp2 / ztmp1  ! L&Y 2004 eq. (10b) 
    189             ztmp1 = 1._wp + Cen * ztmp0 
    190             Ce    = Cen * ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
     181            zsqrt_Cd = vkarmn / ( vkarmn / zsqrt_CdN - ztmp2 ) 
     182            Cd   = zsqrt_Cd * zsqrt_Cd 
     183            ztmp0 = (LOG(zu/10._wp) - psi_h_ncar(zeta_u)) / vkarmn / zsqrt_CdN 
     184            ztmp2 = zsqrt_Cd / zsqrt_CdN 
     185            ztmp1 = 1._wp + zChN * ztmp0 
     186            Ch    = zChN * ztmp2 / ztmp1  ! L&Y 2004 eq. (10b) 
     187            ztmp1 = 1._wp + zCeN * ztmp0 
     188            Ce    = zCeN * ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
    191189 
    192190         ELSE 
    193          ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
    194          !   In very rare low-wind conditions, the old way of estimating the 
    195          !   neutral wind speed at 10m leads to a negative value that causes the code 
    196          !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
    197          ztmp0 = MAX( 0.25_wp , U_blk/(1._wp + sqrt_Cd_n10/vkarmn*(LOG(zu/10._wp) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u)) 
    198          ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10 
    199          Cdn(:,:) = ztmp0 
    200          sqrt_Cd_n10 = sqrt(ztmp0) 
    201  
    202          stab    = 0.5_wp + sign(0.5_wp,zeta_u)                        ! update stability 
    203          Cx_n10  = 1.e-3_wp*sqrt_Cd_n10*(18._wp*stab + 32.7_wp*(1._wp - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10) 
    204          Chn(:,:) = Cx_n10 
     191         ztmp0 = MAX( 0.25_wp , UN10_from_CD(zu, Ubzu, Cd, ppsi=ztmp2) ) ! U_n10 (ztmp2 == psi_m_ncar(zeta_u)) 
     192 
     193         zCdN = cd_n10_ncar(ztmp0) 
     194         zsqrt_CdN = sqrt(zCdN) 
    205195 
    206196         !! Update of transfer coefficients: 
    207          ztmp1 = 1._wp + sqrt_Cd_n10/vkarmn*(LOG(zu/10._wp) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u)) 
    208          Cd      = ztmp0 / ( ztmp1*ztmp1 ) 
    209          stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd)) 
    210  
    211          ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
    212          ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd)) 
    213          ztmp1 = 1._wp + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10) 
    214          Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b) 
    215  
    216          Cx_n10  = 1.e-3_wp * (34.6_wp * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10 
    217          Cen(:,:) = Cx_n10 
    218          ztmp1 = 1._wp + Cx_n10*ztmp0 
    219          Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
     197 
     198         !! C_D 
     199         ztmp1  = 1._wp + zsqrt_CdN/vkarmn*(LOG(zu/10._wp) - ztmp2)   ! L&Y 2004 Eq. (10a) (ztmp2 == psi_m(zeta_u)) 
     200         Cd     = MAX( zCdN / ( ztmp1*ztmp1 ), Cx_min ) 
     201 
     202         !! C_H and C_E 
     203         zsqrt_Cd = SQRT( Cd ) 
     204         ztmp0 = ( LOG(zu/10._wp) - psi_h_ncar(zeta_u) ) / vkarmn / zsqrt_CdN 
     205         ztmp2 = zsqrt_Cd / zsqrt_CdN 
     206 
     207         ztmp1 = 0.5_wp + SIGN(0.5_wp,zeta_u)                                ! update stability 
     208         zChN  = 1.e-3_wp * zsqrt_CdN*(18._wp*ztmp1 + 32.7_wp*(1._wp - ztmp1))  ! L&Y 2004 eq. (6c-6d) 
     209         zCeN  = 1.e-3_wp * (34.6_wp * zsqrt_CdN)                             ! L&Y 2004 eq. (6b) 
     210 
     211         Ch    = MAX( zChN*ztmp2 / ( 1._wp + zChN*ztmp0 ) , Cx_min ) ! L&Y 2004 eq. (10b) 
     212         Ce    = MAX( zCeN*ztmp2 / ( 1._wp + zCeN*ztmp0 ) , Cx_min ) ! L&Y 2004 eq. (10c) 
     213 
    220214         ENDIF 
    221215 
    222       END DO !DO j_itt = 1, nb_itt 
     216      END DO !DO jit = 1, nbit 
     217 
     218      IF(PRESENT(CdN)) CdN(:,:) = zCdN(:,:) 
     219      IF(PRESENT(CeN)) CeN(:,:) = zCeN(:,:) 
     220      IF(PRESENT(ChN)) ChN(:,:) = zChN(:,:) 
    223221 
    224222   END SUBROUTINE turb_ncar 
    225223 
    226224 
    227    FUNCTION cd_neutral_10m( pw10 ) 
    228       !!----------------------------------------------------------------------------------       
     225   FUNCTION cd_n10_ncar( pw10 ) 
     226      !!---------------------------------------------------------------------------------- 
    229227      !! Estimate of the neutral drag coefficient at 10m as a function 
    230228      !! of neutral wind  speed at 10m 
    231229      !! 
    232       !! Origin: Large & Yeager 2008 eq.(11a) and eq.(11b) 
     230      !! Origin: Large & Yeager 2008, Eq. (11) 
    233231      !! 
    234232      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    235233      !!---------------------------------------------------------------------------------- 
    236234      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pw10           ! scalar wind speed at 10m (m/s) 
    237       REAL(wp), DIMENSION(jpi,jpj)             :: cd_neutral_10m 
     235      REAL(wp), DIMENSION(jpi,jpj)             :: cd_n10_ncar 
    238236      ! 
    239237      INTEGER  ::     ji, jj     ! dummy loop indices 
    … …  
    242240      ! 
    243241      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    244          ! 
    245          zw  = pw10(ji,jj) 
    246          zw6 = zw*zw*zw 
    247          zw6 = zw6*zw6 
    248          ! 
    249          ! When wind speed > 33 m/s => Cyclone conditions => special treatment 
    250          zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1 
    251          ! 
    252          cd_neutral_10m(ji,jj) = 1.e-3_wp * ( & 
    253             &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s 
    254             &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s 
    255          ! 
    256          cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6_wp) 
    257          ! 
     242            ! 
     243            zw  = pw10(ji,jj) 
     244            zw6 = zw*zw*zw 
     245            zw6 = zw6*zw6 
     246            ! 
     247            ! When wind speed > 33 m/s => Cyclone conditions => special treatment 
     248            zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1 
     249            ! 
     250            cd_n10_ncar(ji,jj) = 1.e-3_wp * ( & 
     251               &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s 
     252               &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s 
     253            ! 
     254            cd_n10_ncar(ji,jj) = MAX( cd_n10_ncar(ji,jj), Cx_min ) 
     255            ! 
    258256      END_2D 
    259257      ! 
    260    END FUNCTION cd_neutral_10m 
    261  
    262  
    263    FUNCTION psi_m( pzeta ) 
     258   END FUNCTION cd_n10_ncar 
     259 
     260 
     261   FUNCTION ch_n10_ncar( psqrtcdn10 , pstab ) 
     262      !!---------------------------------------------------------------------------------- 
     263      !! Estimate of the neutral heat transfer coefficient at 10m      !! 
     264      !! Origin: Large & Yeager 2008, Eq. (9) and (12) 
     265 
     266      !!---------------------------------------------------------------------------------- 
     267      REAL(wp), DIMENSION(jpi,jpj)             :: ch_n10_ncar 
     268      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 ) 
     269      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pstab      ! stable ABL => 1 / unstable ABL => 0 
     270      !!---------------------------------------------------------------------------------- 
     271      IF( ANY(pstab < -0.00001) .OR. ANY(pstab >  1.00001) ) THEN 
     272         PRINT *, 'ERROR: ch_n10_ncar@mod_blk_ncar.f90: pstab =' 
     273         PRINT *, pstab 
     274         STOP 
     275      END IF 
     276      ! 
     277      ch_n10_ncar = MAX( 1.e-3_wp * psqrtcdn10*( 18._wp*pstab + 32.7_wp*(1._wp - pstab) )  , Cx_min )   ! Eq. (9) & (12) Large & Yeager, 2008 
     278      ! 
     279   END FUNCTION ch_n10_ncar 
     280 
     281   FUNCTION ce_n10_ncar( psqrtcdn10 ) 
     282      !!---------------------------------------------------------------------------------- 
     283      !! Estimate of the neutral heat transfer coefficient at 10m      !! 
     284      !! Origin: Large & Yeager 2008, Eq. (9) and (13) 
     285      !!---------------------------------------------------------------------------------- 
     286      REAL(wp), DIMENSION(jpi,jpj)             :: ce_n10_ncar 
     287      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 ) 
     288      !!---------------------------------------------------------------------------------- 
     289      ce_n10_ncar = MAX( 1.e-3_wp * ( 34.6_wp * psqrtcdn10 ) , Cx_min ) 
     290      ! 
     291   END FUNCTION ce_n10_ncar 
     292 
     293 
     294   FUNCTION psi_m_ncar( pzeta ) 
    264295      !!---------------------------------------------------------------------------------- 
    265296      !! Universal profile stability function for momentum 
    266       !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
     297      !!    !! Psis, L&Y 2004, Eq. (8c), (8d), (8e) 
    267298      !! 
    268299      !! pzeta : stability paramenter, z/L where z is altitude measurement 
    … …  
    271302      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    272303      !!---------------------------------------------------------------------------------- 
    273       REAL(wp), DIMENSION(jpi,jpj) :: psi_m 
     304      REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ncar 
    274305      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
    275306      ! 
    276307      INTEGER  ::   ji, jj    ! dummy loop indices 
    277       REAL(wp) :: zx2, zx, zstab   ! local scalars 
     308      REAL(wp) :: zta, zx2, zx, zpsi_unst, zpsi_stab, zstab   ! local scalars 
    278309      !!---------------------------------------------------------------------------------- 
    279310      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    280          zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 
    281          zx2 = MAX( zx2 , 1._wp ) 
    282          zx  = SQRT( zx2 ) 
    283          zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) ) 
    284          ! 
    285          psi_m(ji,jj) =        zstab  * (-5._wp*pzeta(ji,jj))       &          ! Stable 
    286             &          + (1._wp - zstab) * (2._wp*LOG((1._wp + zx)*0.5_wp)   &          ! Unstable 
    287             &               + LOG((1._wp + zx2)*0.5_wp) - 2._wp*ATAN(zx) + rpi*0.5_wp)  !    " 
    288          ! 
     311            zta = pzeta(ji,jj) 
     312            ! 
     313            zx2 = SQRT( ABS(1._wp - 16._wp*zta) )  ! (1 - 16z)^0.5 
     314            zx2 = MAX( zx2 , 1._wp ) 
     315            zx  = SQRT(zx2)                          ! (1 - 16z)^0.25 
     316            zpsi_unst = 2._wp*LOG( (1._wp + zx )*0.5_wp )   & 
     317               &            + LOG( (1._wp + zx2)*0.5_wp )   & 
     318               &          - 2._wp*ATAN(zx) + rpi*0.5_wp 
     319            ! 
     320            zpsi_stab = -5._wp*zta 
     321            ! 
     322            zstab = 0.5_wp + SIGN(0.5_wp, zta) ! zta > 0 => zstab = 1 
     323            ! 
     324            psi_m_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zta > 0) Stable 
     325               &              + (1._wp - zstab) * zpsi_unst    ! (zta < 0) Unstable 
     326            ! 
     327            ! 
    289328      END_2D 
    290    END FUNCTION psi_m 
    291  
    292  
    293    FUNCTION psi_h( pzeta ) 
     329   END FUNCTION psi_m_ncar 
     330 
     331 
     332   FUNCTION psi_h_ncar( pzeta ) 
    294333      !!---------------------------------------------------------------------------------- 
    295334      !! Universal profile stability function for temperature and humidity 
    296       !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
     335      !!    !! Psis, L&Y 2004, Eq. (8c), (8d), (8e) 
    297336      !! 
    298337      !! pzeta : stability paramenter, z/L where z is altitude measurement 
    … …  
    301340      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    302341      !!---------------------------------------------------------------------------------- 
    303       REAL(wp), DIMENSION(jpi,jpj) :: psi_h 
     342      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ncar 
    304343      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
    305344      ! 
    306345      INTEGER  ::   ji, jj     ! dummy loop indices 
    307       REAL(wp) :: zx2, zstab  ! local scalars 
     346      REAL(wp) :: zta, zx2, zpsi_unst, zpsi_stab, zstab  ! local scalars 
    308347      !!---------------------------------------------------------------------------------- 
    309348      ! 
    310349      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    311          zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 
    312          zx2 = MAX( zx2 , 1._wp ) 
    313          zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) ) 
    314          ! 
    315          psi_h(ji,jj) =         zstab  * (-5._wp*pzeta(ji,jj))        &  ! Stable 
    316             &           + (1._wp - zstab) * (2._wp*LOG( (1._wp + zx2)*0.5_wp ))   ! Unstable 
    317          ! 
     350            ! 
     351            zta = pzeta(ji,jj) 
     352            ! 
     353            zx2 = SQRT( ABS(1._wp - 16._wp*zta) )  ! (1 -16z)^0.5 
     354            zx2 = MAX( zx2 , 1._wp ) 
     355            zpsi_unst = 2._wp*LOG( 0.5_wp*(1._wp + zx2) ) 
     356            ! 
     357            zpsi_stab = -5._wp*zta 
     358            ! 
     359            zstab = 0.5_wp + SIGN(0.5_wp, zta) ! zta > 0 => zstab = 1 
     360            ! 
     361            psi_h_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zta > 0) Stable 
     362               &              + (1._wp - zstab) * zpsi_unst    ! (zta < 0) Unstable 
     363            ! 
    318364      END_2D 
    319    END FUNCTION psi_h 
     365   END FUNCTION psi_h_ncar 
    320366 
    321367   !!====================================================================== 

  • NEMO/trunk/src/OCE/SBC/sbcblk_skin_coare.F90

    r13460 r14072  
    1313   !! ** Author: L. Brodeau, November 2019 / AeroBulk (https://github.com/brodeau/aerobulk) 
    1414   !!---------------------------------------------------------------------- 
    15    !! History :  4.x  !  2019-11  (L.Brodeau)   Original code 
     15   !! History :  4.0  !  2019-11  (L.Brodeau)   Original code 
    1616   !!---------------------------------------------------------------------- 
    1717   USE oce             ! ocean dynamics and tracers 
    … …  
    2020   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2121 
    22    USE sbcblk_phy      ! misc. functions for marine ABL physics (rho_air, q_sat, bulk_formula, etc) 
     22   USE sbc_phy         ! Catalog of functions for physical/meteorological parameters in the marine boundary layer 
    2323 
    2424   USE sbcdcy          !#LB: to know hour of dawn and dusk: rdawn_dcy and rdusk_dcy (needed in WL_COARE) 

  • NEMO/trunk/src/OCE/SBC/sbcblk_skin_ecmwf.F90

    r13460 r14072  
    2828   !! ** Author: L. Brodeau, November 2019 / AeroBulk (https://github.com/brodeau/aerobulk) 
    2929   !!---------------------------------------------------------------------- 
    30    !! History :  4.x  !  2019-11  (L.Brodeau)   Original code 
     30   !! History :  4.0  ! 2019-11  (L.Brodeau)   Original code 
     31   !!            4.2  ! 2020-12  (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 
    3132   !!---------------------------------------------------------------------- 
    3233   USE oce             ! ocean dynamics and tracers 
    … …  
    3536   USE sbc_oce         ! Surface boundary condition: ocean fields 
    3637 
    37    USE sbcblk_phy      ! misc. functions for marine ABL physics (rho_air, q_sat, bulk_formula, etc) 
     38   USE sbc_phy         ! Catalog of functions for physical/meteorological parameters in the marine boundary layer 
    3839 
    3940   USE lib_mpp         ! distribued memory computing library 
    … …  
    160161      REAL(wp) :: zalfa     !: thermal expansion coefficient of sea-water [1/K] 
    161162      REAL(wp) :: zdTwl_b, zdTwl_n  !: temp. diff. between "almost surface (right below viscous layer) and bottom of WL 
    162       REAL(wp) :: zfr, zeta  
    163       REAL(wp) :: zusw, zusw2  
    164       REAL(wp) :: zLa, zfLa  
    165       REAL(wp) :: flg, zwf, zQabs  
     163      REAL(wp) :: zfr, zeta 
     164      REAL(wp) :: zusw, zusw2 
     165      REAL(wp) :: zLa, zfLa 
     166      REAL(wp) :: flg, zwf, zQabs 
    166167      REAL(wp) :: ZA, ZB, zL1, zL2 
    167168      REAL(wp) :: zcst0, zcst1, zcst2, zcst3 

  • NEMO/trunk/src/OCE/SBC/sbccpl.F90

    r14007 r14072  
    3333#endif 
    3434   USE cpl_oasis3     ! OASIS3 coupling 
    35    USE geo2ocean      !  
     35   USE geo2ocean      ! 
    3636   USE oce     , ONLY : ts, uu, vv, ssh, fraqsr_1lev 
    37    USE ocealb         !  
    38    USE eosbn2         !  
     37   USE ocealb         ! 
     38   USE eosbn2         ! 
    3939   USE sbcrnf  , ONLY : l_rnfcpl 
    4040#if defined key_cice 
    … …  
    5050   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    5151 
    52 #if defined key_oasis3  
    53    USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut  
    54 #endif  
     52#if defined key_oasis3 
     53   USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut 
     54#endif 
     55 
     56   USE sbc_phy, ONLY : pp_cldf 
    5557 
    5658   IMPLICIT NONE 
    … …  
    6567 
    6668   INTEGER, PARAMETER ::   jpr_otx1   =  1   ! 3 atmosphere-ocean stress components on grid 1 
    67    INTEGER, PARAMETER ::   jpr_oty1   =  2   !  
    68    INTEGER, PARAMETER ::   jpr_otz1   =  3   !  
     69   INTEGER, PARAMETER ::   jpr_oty1   =  2   ! 
     70   INTEGER, PARAMETER ::   jpr_otz1   =  3   ! 
    6971   INTEGER, PARAMETER ::   jpr_otx2   =  4   ! 3 atmosphere-ocean stress components on grid 2 
    70    INTEGER, PARAMETER ::   jpr_oty2   =  5   !  
    71    INTEGER, PARAMETER ::   jpr_otz2   =  6   !  
     72   INTEGER, PARAMETER ::   jpr_oty2   =  5   ! 
     73   INTEGER, PARAMETER ::   jpr_otz2   =  6   ! 
    7274   INTEGER, PARAMETER ::   jpr_itx1   =  7   ! 3 atmosphere-ice   stress components on grid 1 
    73    INTEGER, PARAMETER ::   jpr_ity1   =  8   !  
    74    INTEGER, PARAMETER ::   jpr_itz1   =  9   !  
     75   INTEGER, PARAMETER ::   jpr_ity1   =  8   ! 
     76   INTEGER, PARAMETER ::   jpr_itz1   =  9   ! 
    7577   INTEGER, PARAMETER ::   jpr_itx2   = 10   ! 3 atmosphere-ice   stress components on grid 2 
    76    INTEGER, PARAMETER ::   jpr_ity2   = 11   !  
    77    INTEGER, PARAMETER ::   jpr_itz2   = 12   !  
     78   INTEGER, PARAMETER ::   jpr_ity2   = 11   ! 
     79   INTEGER, PARAMETER ::   jpr_itz2   = 12   ! 
    7880   INTEGER, PARAMETER ::   jpr_qsroce = 13   ! Qsr above the ocean 
    7981   INTEGER, PARAMETER ::   jpr_qsrice = 14   ! Qsr above the ice 
    80    INTEGER, PARAMETER ::   jpr_qsrmix = 15  
     82   INTEGER, PARAMETER ::   jpr_qsrmix = 15 
    8183   INTEGER, PARAMETER ::   jpr_qnsoce = 16   ! Qns above the ocean 
    8284   INTEGER, PARAMETER ::   jpr_qnsice = 17   ! Qns above the ice 
    … …  
    103105   INTEGER, PARAMETER ::   jpr_ocy1   = 38   ! 
    104106   INTEGER, PARAMETER ::   jpr_ssh    = 39   ! sea surface height 
    105    INTEGER, PARAMETER ::   jpr_fice   = 40   ! ice fraction           
    106    INTEGER, PARAMETER ::   jpr_e3t1st = 41   ! first T level thickness  
     107   INTEGER, PARAMETER ::   jpr_fice   = 40   ! ice fraction 
     108   INTEGER, PARAMETER ::   jpr_e3t1st = 41   ! first T level thickness 
    107109   INTEGER, PARAMETER ::   jpr_fraqsr = 42   ! fraction of solar net radiation absorbed in the first ocean level 
    108    INTEGER, PARAMETER ::   jpr_mslp   = 43   ! mean sea level pressure  
     110   INTEGER, PARAMETER ::   jpr_mslp   = 43   ! mean sea level pressure 
    109111   !**  surface wave coupling  ** 
    110112   INTEGER, PARAMETER ::   jpr_hsig   = 44   ! Hsig 
    … …  
    128130   INTEGER, PARAMETER ::   jpr_ts_ice = 62   ! Sea ice surface temp 
    129131 
    130    INTEGER, PARAMETER ::   jprcv      = 62   ! total number of fields received   
     132   INTEGER, PARAMETER ::   jprcv      = 62   ! total number of fields received 
    131133 
    132134   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere 
    … …  
    152154   INTEGER, PARAMETER ::   jps_sflx   = 21   ! salt flux 
    153155   INTEGER, PARAMETER ::   jps_otx1   = 22   ! 2 atmosphere-ocean stress components on grid 1 
    154    INTEGER, PARAMETER ::   jps_oty1   = 23   !  
     156   INTEGER, PARAMETER ::   jps_oty1   = 23   ! 
    155157   INTEGER, PARAMETER ::   jps_rnf    = 24   ! runoffs 
    156158   INTEGER, PARAMETER ::   jps_taum   = 25   ! wind stress module 
    … …  
    158160   INTEGER, PARAMETER ::   jps_e3t1st = 27   ! first level depth (vvl) 
    159161   INTEGER, PARAMETER ::   jps_fraqsr = 28   ! fraction of solar net radiation absorbed in the first ocean level 
    160    INTEGER, PARAMETER ::   jps_ficet  = 29   ! total ice fraction   
    161    INTEGER, PARAMETER ::   jps_ocxw   = 30   ! currents on grid 1   
     162   INTEGER, PARAMETER ::   jps_ficet  = 29   ! total ice fraction 
     163   INTEGER, PARAMETER ::   jps_ocxw   = 30   ! currents on grid 1 
    162164   INTEGER, PARAMETER ::   jps_ocyw   = 31   ! currents on grid 2 
    163    INTEGER, PARAMETER ::   jps_wlev   = 32   ! water level  
     165   INTEGER, PARAMETER ::   jps_wlev   = 32   ! water level 
    164166   INTEGER, PARAMETER ::   jps_fice1  = 33   ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 
    165167   INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area fraction 
    … …  
    169171   INTEGER, PARAMETER ::   jps_ttilyr = 38   ! sea ice top layer temp 
    170172 
    171    INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent  
    172  
    173 #if ! defined key_oasis3  
    174    ! Dummy variables to enable compilation when oasis3 is not being used  
    175    INTEGER                    ::   OASIS_Sent        = -1  
    176    INTEGER                    ::   OASIS_SentOut     = -1  
    177    INTEGER                    ::   OASIS_ToRest      = -1  
    178    INTEGER                    ::   OASIS_ToRestOut   = -1  
    179 #endif  
     173   INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent 
     174 
     175#if ! defined key_oasis3 
     176   ! Dummy variables to enable compilation when oasis3 is not being used 
     177   INTEGER                    ::   OASIS_Sent        = -1 
     178   INTEGER                    ::   OASIS_SentOut     = -1 
     179   INTEGER                    ::   OASIS_ToRest      = -1 
     180   INTEGER                    ::   OASIS_ToRestOut   = -1 
     181#endif 
    180182 
    181183   !                                  !!** namelist namsbc_cpl ** 
    182    TYPE ::   FLD_C                     !    
     184   TYPE ::   FLD_C                     ! 
    183185      CHARACTER(len = 32) ::   cldes      ! desciption of the coupling strategy 
    184186      CHARACTER(len = 32) ::   clcat      ! multiple ice categories strategy 
    … …  
    187189      CHARACTER(len = 32) ::   clvgrd     ! grids on which is located the vector fields 
    188190   END TYPE FLD_C 
    189    !                                   ! Send to the atmosphere   
     191   !                                   ! Send to the atmosphere 
    190192   TYPE(FLD_C) ::   sn_snd_temp  , sn_snd_alb , sn_snd_thick, sn_snd_crt   , sn_snd_co2,  & 
    191193      &             sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr 
    … …  
    194196      &             sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf, sn_rcv_ts_ice 
    195197   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf 
    196    !                                   ! Send to waves  
    197    TYPE(FLD_C) ::   sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev  
    198    !                                   ! Received from waves  
     198   !                                   ! Send to waves 
     199   TYPE(FLD_C) ::   sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev 
     200   !                                   ! Received from waves 
    199201   TYPE(FLD_C) ::   sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, & 
    200202      &             sn_rcv_wstrf, sn_rcv_wdrag, sn_rcv_charn, sn_rcv_taw, sn_rcv_bhd, sn_rcv_tusd, sn_rcv_tvsd 
    … …  
    203205   LOGICAL     ::   ln_usecplmask         !  use a coupling mask file to merge data received from several models 
    204206                                          !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    205    LOGICAL     ::   ln_scale_ice_flux     !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration)  
    206  
    207    TYPE ::   DYNARR      
    208       REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3    
     207   LOGICAL     ::   ln_scale_ice_flux     !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 
     208 
     209   TYPE ::   DYNARR 
     210      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3 
    209211   END TYPE DYNARR 
    210212 
    … …  
    216218#endif 
    217219 
    218    REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure[N/m2]  
    219    REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rho0)  
     220   REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure[N/m2] 
     221   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rho0) 
    220222 
    221223   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nrcvinfo           ! OASIS info argument 
    … …  
    230232   !!---------------------------------------------------------------------- 
    231233CONTAINS 
    232    
     234 
    233235   INTEGER FUNCTION sbc_cpl_alloc() 
    234236      !!---------------------------------------------------------------------- 
    … …  
    240242      ! 
    241243      ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) ) 
    242        
     244 
    243245#if ! defined key_si3 && ! defined key_cice 
    244246      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    … …  
    258260 
    259261 
    260    SUBROUTINE sbc_cpl_init( k_ice )      
     262   SUBROUTINE sbc_cpl_init( k_ice ) 
    261263      !!---------------------------------------------------------------------- 
    262264      !!             ***  ROUTINE sbc_cpl_init  *** 
    … …  
    265267      !!                the atmospheric component 
    266268      !! 
    267       !! ** Method  : * Read namsbc_cpl namelist  
     269      !! ** Method  : * Read namsbc_cpl namelist 
    268270      !!              * define the receive interface 
    269271      !!              * define the send    interface 
    … …  
    277279      !! 
    278280      NAMELIST/namsbc_cpl/  nn_cplmodel  , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux,             & 
    279          &                  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2   ,  &  
    280          &                  sn_snd_ttilyr, sn_snd_cond  , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1,  &  
    281          &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc ,  &  
    282          &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  &  
     281         &                  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2   ,  & 
     282         &                  sn_snd_ttilyr, sn_snd_cond  , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1,  & 
     283         &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc ,  & 
     284         &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  & 
    283285         &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_wstrf ,  & 
    284286         &                  sn_rcv_charn , sn_rcv_taw   , sn_rcv_bhd  , sn_rcv_tusd  , sn_rcv_tvsd,    & 
    285287         &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal  ,   & 
    286          &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_icb  , sn_rcv_isf   , sn_rcv_ts_ice  
     288         &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_icb  , sn_rcv_isf   , sn_rcv_ts_ice 
    287289 
    288290      !!--------------------------------------------------------------------- 
    … …  
    328330         WRITE(numout,*)'      Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' 
    329331         WRITE(numout,*)'      surface waves:' 
    330          WRITE(numout,*)'      significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')'  
    331          WRITE(numout,*)'      wave to oce energy flux         = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')'  
    332          WRITE(numout,*)'      Surface Stokes drift grid u     = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')'  
    333          WRITE(numout,*)'      Surface Stokes drift grid v     = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')'  
    334          WRITE(numout,*)'      Mean wave period                = ', TRIM(sn_rcv_wper%cldes  ), ' (', TRIM(sn_rcv_wper%clcat  ), ')'  
    335          WRITE(numout,*)'      Mean wave number                = ', TRIM(sn_rcv_wnum%cldes  ), ' (', TRIM(sn_rcv_wnum%clcat  ), ')'  
     332         WRITE(numout,*)'      significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')' 
     333         WRITE(numout,*)'      wave to oce energy flux         = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' 
     334         WRITE(numout,*)'      Surface Stokes drift grid u     = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')' 
     335         WRITE(numout,*)'      Surface Stokes drift grid v     = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')' 
     336         WRITE(numout,*)'      Mean wave period                = ', TRIM(sn_rcv_wper%cldes  ), ' (', TRIM(sn_rcv_wper%clcat  ), ')' 
     337         WRITE(numout,*)'      Mean wave number                = ', TRIM(sn_rcv_wnum%cldes  ), ' (', TRIM(sn_rcv_wnum%clcat  ), ')' 
    336338         WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 
    337          WRITE(numout,*)'      Neutral surf drag coefficient   = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')'  
     339         WRITE(numout,*)'      Neutral surf drag coefficient   = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 
    338340         WRITE(numout,*)'      Charnock coefficient            = ', TRIM(sn_rcv_charn%cldes ), ' (', TRIM(sn_rcv_charn%clcat ), ')' 
    339341         WRITE(numout,*)'  sent fields (multiple ice categories)' 
    … …  
    342344         WRITE(numout,*)'      albedo                          = ', TRIM(sn_snd_alb%cldes   ), ' (', TRIM(sn_snd_alb%clcat   ), ')' 
    343345         WRITE(numout,*)'      ice/snow thickness              = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')' 
    344          WRITE(numout,*)'      total ice fraction              = ', TRIM(sn_snd_ifrac%cldes ), ' (', TRIM(sn_snd_ifrac%clcat ), ')'  
     346         WRITE(numout,*)'      total ice fraction              = ', TRIM(sn_snd_ifrac%cldes ), ' (', TRIM(sn_snd_ifrac%clcat ), ')' 
    345347         WRITE(numout,*)'      surface current                 = ', TRIM(sn_snd_crt%cldes   ), ' (', TRIM(sn_snd_crt%clcat   ), ')' 
    346          WRITE(numout,*)'                      - referential   = ', sn_snd_crt%clvref  
     348         WRITE(numout,*)'                      - referential   = ', sn_snd_crt%clvref 
    347349         WRITE(numout,*)'                      - orientation   = ', sn_snd_crt%clvor 
    348350         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd 
    … …  
    351353         WRITE(numout,*)'      meltponds fraction and depth    = ', TRIM(sn_snd_mpnd%cldes  ), ' (', TRIM(sn_snd_mpnd%clcat  ), ')' 
    352354         WRITE(numout,*)'      sea surface freezing temp       = ', TRIM(sn_snd_sstfrz%cldes), ' (', TRIM(sn_snd_sstfrz%clcat), ')' 
    353          WRITE(numout,*)'      water level                     = ', TRIM(sn_snd_wlev%cldes  ), ' (', TRIM(sn_snd_wlev%clcat  ), ')'  
    354          WRITE(numout,*)'      mean sea level pressure         = ', TRIM(sn_rcv_mslp%cldes  ), ' (', TRIM(sn_rcv_mslp%clcat  ), ')'  
    355          WRITE(numout,*)'      surface current to waves        = ', TRIM(sn_snd_crtw%cldes  ), ' (', TRIM(sn_snd_crtw%clcat  ), ')'  
    356          WRITE(numout,*)'                      - referential   = ', sn_snd_crtw%clvref  
    357          WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor  
    358          WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd  
     355         WRITE(numout,*)'      water level                     = ', TRIM(sn_snd_wlev%cldes  ), ' (', TRIM(sn_snd_wlev%clcat  ), ')' 
     356         WRITE(numout,*)'      mean sea level pressure         = ', TRIM(sn_rcv_mslp%cldes  ), ' (', TRIM(sn_rcv_mslp%clcat  ), ')' 
     357         WRITE(numout,*)'      surface current to waves        = ', TRIM(sn_snd_crtw%cldes  ), ' (', TRIM(sn_snd_crtw%clcat  ), ')' 
     358         WRITE(numout,*)'                      - referential   = ', sn_snd_crtw%clvref 
     359         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor 
     360         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd 
    359361      ENDIF 
    360362      IF( lwp .AND. ln_wave) THEN                        ! control print 
    … …  
    380382      !                                   ! allocate sbccpl arrays 
    381383      IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    382       
     384 
    383385      ! ================================ ! 
    384386      !   Define the receive interface   ! 
    385387      ! ================================ ! 
    386       nrcvinfo(:) = OASIS_idle   ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress  
     388      nrcvinfo(:) = OASIS_idle   ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress 
    387389 
    388390      ! for each field: define the OASIS name                              (srcv(:)%clname) 
    … …  
    394396 
    395397      !                                                      ! ------------------------- ! 
    396       !                                                      ! ice and ocean wind stress !    
    397       !                                                      ! ------------------------- ! 
    398       !                                                           ! Name  
     398      !                                                      ! ice and ocean wind stress ! 
     399      !                                                      ! ------------------------- ! 
     400      !                                                           ! Name 
    399401      srcv(jpr_otx1)%clname = 'O_OTaux1'      ! 1st ocean component on grid ONE (T or U) 
    400       srcv(jpr_oty1)%clname = 'O_OTauy1'      ! 2nd   -      -         -     -  
    401       srcv(jpr_otz1)%clname = 'O_OTauz1'      ! 3rd   -      -         -     -  
     402      srcv(jpr_oty1)%clname = 'O_OTauy1'      ! 2nd   -      -         -     - 
     403      srcv(jpr_otz1)%clname = 'O_OTauz1'      ! 3rd   -      -         -     - 
    402404      srcv(jpr_otx2)%clname = 'O_OTaux2'      ! 1st ocean component on grid TWO (V) 
    403       srcv(jpr_oty2)%clname = 'O_OTauy2'      ! 2nd   -      -         -     -  
    404       srcv(jpr_otz2)%clname = 'O_OTauz2'      ! 3rd   -      -         -     -  
     405      srcv(jpr_oty2)%clname = 'O_OTauy2'      ! 2nd   -      -         -     - 
     406      srcv(jpr_otz2)%clname = 'O_OTauz2'      ! 3rd   -      -         -     - 
    405407      ! 
    406408      srcv(jpr_itx1)%clname = 'O_ITaux1'      ! 1st  ice  component on grid ONE (T, F, I or U) 
    407       srcv(jpr_ity1)%clname = 'O_ITauy1'      ! 2nd   -      -         -     -  
    408       srcv(jpr_itz1)%clname = 'O_ITauz1'      ! 3rd   -      -         -     -  
     409      srcv(jpr_ity1)%clname = 'O_ITauy1'      ! 2nd   -      -         -     - 
     410      srcv(jpr_itz1)%clname = 'O_ITauz1'      ! 3rd   -      -         -     - 
    409411      srcv(jpr_itx2)%clname = 'O_ITaux2'      ! 1st  ice  component on grid TWO (V) 
    410       srcv(jpr_ity2)%clname = 'O_ITauy2'      ! 2nd   -      -         -     -  
    411       srcv(jpr_itz2)%clname = 'O_ITauz2'      ! 3rd   -      -         -     -  
    412       !  
     412      srcv(jpr_ity2)%clname = 'O_ITauy2'      ! 2nd   -      -         -     - 
     413      srcv(jpr_itz2)%clname = 'O_ITauz2'      ! 3rd   -      -         -     - 
     414      ! 
    413415      ! Vectors: change of sign at north fold ONLY if on the local grid 
    414416      IF(       TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice'  & 
    … …  
    416418      ! 
    417419      IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 
    418        
     420 
    419421      !                                                           ! Set grid and action 
    420422      SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) )      !  'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V' 
    421       CASE( 'T' )  
     423      CASE( 'T' ) 
    422424         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point 
    423          srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1  
    424          srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1  
    425       CASE( 'U,V' )  
     425         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 
     426         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 
     427      CASE( 'U,V' ) 
    426428         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point 
    427429         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point 
    … …  
    447449         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
    448450         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only 
    449       CASE( 'T,I' )  
     451      CASE( 'T,I' ) 
    450452         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point 
    451453         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point 
    452          srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1  
    453          srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1  
    454       CASE( 'T,F' )  
     454         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 
     455         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 
     456      CASE( 'T,F' ) 
    455457         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point 
    456458         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point 
    457          srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1  
    458          srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1  
     459         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 
     460         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 
    459461      CASE( 'T,U,V' ) 
    460462         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'T'        ! oce components given at T-point 
    … …  
    463465         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 only 
    464466         srcv(jpr_itx1:jpr_itz2)%laction = .TRUE.     ! receive ice components on grid 1 & 2 
    465       CASE default    
     467      CASE default 
    466468         CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' ) 
    467469      END SELECT 
    468470      ! 
    469471      IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' )   &           ! spherical: 3rd component not received 
    470          &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.  
     472         &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 
    471473      ! 
    472474      IF( TRIM( sn_rcv_tau%clvor  ) == 'local grid' ) THEN        ! already on local grid -> no need of the second grid 
    473             srcv(jpr_otx2:jpr_otz2)%laction = .FALSE.  
    474             srcv(jpr_itx2:jpr_itz2)%laction = .FALSE.  
     475            srcv(jpr_otx2:jpr_otz2)%laction = .FALSE. 
     476            srcv(jpr_itx2:jpr_itz2)%laction = .FALSE. 
    475477            srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid   ! not needed but cleaner... 
    476478            srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid   ! not needed but cleaner... 
    … …  
    488490      !                                                      ! ------------------------- ! 
    489491      ! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid) 
    490       ! over ice of free ocean within the same atmospheric cell.cd  
     492      ! over ice of free ocean within the same atmospheric cell.cd 
    491493      srcv(jpr_rain)%clname = 'OTotRain'      ! Rain = liquid precipitation 
    492494      srcv(jpr_snow)%clname = 'OTotSnow'      ! Snow = solid precipitation 
    493495      srcv(jpr_tevp)%clname = 'OTotEvap'      ! total evaporation (over oce + ice sublimation) 
    494496      srcv(jpr_ievp)%clname = 'OIceEvap'      ! evaporation over ice = sublimation 
    495       srcv(jpr_sbpr)%clname = 'OSubMPre'      ! sublimation - liquid precipitation - solid precipitation  
     497      srcv(jpr_sbpr)%clname = 'OSubMPre'      ! sublimation - liquid precipitation - solid precipitation 
    496498      srcv(jpr_semp)%clname = 'OISubMSn'      ! ice solid water budget = sublimation - solid precipitation 
    497499      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip 
    498500      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    499501      CASE( 'none'          )       ! nothing to do 
    500       CASE( 'oce only'      )   ;   srcv(jpr_oemp)%laction = .TRUE.  
     502      CASE( 'oce only'      )   ;   srcv(jpr_oemp)%laction = .TRUE. 
    501503      CASE( 'conservative'  ) 
    502504         srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 
    … …  
    507509      ! 
    508510      !                                                      ! ------------------------- ! 
    509       !                                                      !     Runoffs & Calving     !    
     511      !                                                      !     Runoffs & Calving     ! 
    510512      !                                                      ! ------------------------- ! 
    511513      srcv(jpr_rnf   )%clname = 'O_Runoff' 
    … …  
    540542      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 
    541543      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE. 
    542       CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qnsmix   )%laction = .TRUE.  
     544      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qnsmix   )%laction = .TRUE. 
    543545      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 
    544546      END SELECT 
    … …  
    557559      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 
    558560      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE. 
    559       CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qsrmix   )%laction = .TRUE.  
     561      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qsrmix   )%laction = .TRUE. 
    560562      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 
    561563      END SELECT 
    … …  
    566568      !                                                      !   non solar sensitivity   !   d(Qns)/d(T) 
    567569      !                                                      ! ------------------------- ! 
    568       srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'    
     570      srcv(jpr_dqnsdt)%clname = 'O_dQnsdT' 
    569571      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' )   srcv(jpr_dqnsdt)%laction = .TRUE. 
    570572      ! 
    … …  
    574576      ! 
    575577      !                                                      ! ------------------------- ! 
    576       !                                                      !      10m wind module      !    
    577       !                                                      ! ------------------------- ! 
    578       srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(sn_rcv_w10m%cldes  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE.  
    579       ! 
    580       !                                                      ! ------------------------- ! 
    581       !                                                      !   wind stress module      !    
     578      !                                                      !      10m wind module      ! 
     579      !                                                      ! ------------------------- ! 
     580      srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(sn_rcv_w10m%cldes  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE. 
     581      ! 
     582      !                                                      ! ------------------------- ! 
     583      !                                                      !   wind stress module      ! 
    582584      !                                                      ! ------------------------- ! 
    583585      srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE. 
    … …  
    586588      !                                                      !      Atmospheric CO2      ! 
    587589      !                                                      ! ------------------------- ! 
    588       srcv(jpr_co2 )%clname = 'O_AtmCO2'    
     590      srcv(jpr_co2 )%clname = 'O_AtmCO2' 
    589591      IF( TRIM(sn_rcv_co2%cldes   ) == 'coupled' )  THEN 
    590592         srcv(jpr_co2 )%laction = .TRUE. 
    … …  
    595597      ENDIF 
    596598      ! 
    597       !                                                      ! ------------------------- !  
    598       !                                                      ! Mean Sea Level Pressure   !  
    599       !                                                      ! ------------------------- !  
    600       srcv(jpr_mslp)%clname = 'O_MSLP'     ;   IF( TRIM(sn_rcv_mslp%cldes  ) == 'coupled' )    srcv(jpr_mslp)%laction = .TRUE.  
    601       ! 
    602       !                                                      ! ------------------------- ! 
    603       !                                                      !  ice topmelt and botmelt  !    
     599      !                                                      ! ------------------------- ! 
     600      !                                                      ! Mean Sea Level Pressure   ! 
     601      !                                                      ! ------------------------- ! 
     602      srcv(jpr_mslp)%clname = 'O_MSLP'     ;   IF( TRIM(sn_rcv_mslp%cldes  ) == 'coupled' )    srcv(jpr_mslp)%laction = .TRUE. 
     603      ! 
     604      !                                                      ! ------------------------- ! 
     605      !                                                      !  ice topmelt and botmelt  ! 
    604606      !                                                      ! ------------------------- ! 
    605607      srcv(jpr_topm )%clname = 'OTopMlt' 
    … …  
    614616      ENDIF 
    615617      !                                                      ! ------------------------- ! 
    616       !                                                      !    ice skin temperature   !    
     618      !                                                      !    ice skin temperature   ! 
    617619      !                                                      ! ------------------------- ! 
    618620      srcv(jpr_ts_ice)%clname = 'OTsfIce'    ! needed by Met Office 
    … …  
    622624 
    623625#if defined key_si3 
    624       IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN  
     626      IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN 
    625627         IF( .NOT.srcv(jpr_ts_ice)%laction )  & 
    626             &   CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' )      
     628            &   CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' ) 
    627629      ENDIF 
    628630#endif 
    629631      !                                                      ! ------------------------- ! 
    630       !                                                      !      Wave breaking        !     
    631       !                                                      ! ------------------------- !  
     632      !                                                      !      Wave breaking        ! 
     633      !                                                      ! ------------------------- ! 
    632634      srcv(jpr_hsig)%clname  = 'O_Hsigwa'    ! significant wave height 
    633635      IF( TRIM(sn_rcv_hsig%cldes  ) == 'coupled' )  THEN 
    … …  
    704706      ! 
    705707      !                                                      ! ------------------------------- ! 
    706       !                                                      !   OPA-SAS coupling - rcv by opa !    
     708      !                                                      !   OPA-SAS coupling - rcv by opa ! 
    707709      !                                                      ! ------------------------------- ! 
    708710      srcv(jpr_sflx)%clname = 'O_SFLX' 
    … …  
    740742      ENDIF 
    741743      !                                                      ! -------------------------------- ! 
    742       !                                                      !   OPA-SAS coupling - rcv by sas  !    
     744      !                                                      !   OPA-SAS coupling - rcv by sas  ! 
    743745      !                                                      ! -------------------------------- ! 
    744746      srcv(jpr_toce  )%clname = 'I_SSTSST' 
    … …  
    747749      srcv(jpr_ocy1  )%clname = 'I_OCury1' 
    748750      srcv(jpr_ssh   )%clname = 'I_SSHght' 
    749       srcv(jpr_e3t1st)%clname = 'I_E3T1st'    
    750       srcv(jpr_fraqsr)%clname = 'I_FraQsr'    
     751      srcv(jpr_e3t1st)%clname = 'I_E3T1st' 
     752      srcv(jpr_fraqsr)%clname = 'I_FraQsr' 
    751753      ! 
    752754      IF( nn_components == jp_iam_sas ) THEN 
    … …  
    778780            ENDIF 
    779781            WRITE(numout,*)'               sea surface temperature (Celsius) ' 
    780             WRITE(numout,*)'               sea surface salinity '  
    781             WRITE(numout,*)'               surface currents '  
    782             WRITE(numout,*)'               sea surface height '  
    783             WRITE(numout,*)'               thickness of first ocean T level '         
     782            WRITE(numout,*)'               sea surface salinity ' 
     783            WRITE(numout,*)'               surface currents ' 
     784            WRITE(numout,*)'               sea surface height ' 
     785            WRITE(numout,*)'               thickness of first ocean T level ' 
    784786            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
    785787            WRITE(numout,*) 
    786788         ENDIF 
    787789      ENDIF 
    788        
     790 
    789791      ! =================================================== ! 
    790792      ! Allocate all parts of frcv used for received fields ! 
    … …  
    812814      !                 define send or not from the namelist parameters (ssnd(:)%laction) 
    813815      !                 define the north fold type of lbc               (ssnd(:)%nsgn) 
    814        
     816 
    815817      ! default definitions of nsnd 
    816818      ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1 
    817           
     819 
    818820      !                                                      ! ------------------------- ! 
    819821      !                                                      !    Surface temperature    ! 
    … …  
    832834      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 
    833835      END SELECT 
    834             
     836 
    835837      !                                                      ! ------------------------- ! 
    836838      !                                                      !          Albedo           ! 
    837839      !                                                      ! ------------------------- ! 
    838       ssnd(jps_albice)%clname = 'O_AlbIce'  
     840      ssnd(jps_albice)%clname = 'O_AlbIce' 
    839841      ssnd(jps_albmix)%clname = 'O_AlbMix' 
    840842      SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 
    … …  
    847849      ! Need to calculate oceanic albedo if 
    848850      !     1. sending mixed oce-ice albedo or 
    849       !     2. receiving mixed oce-ice solar radiation  
     851      !     2. receiving mixed oce-ice solar radiation 
    850852      IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 
    851853         CALL oce_alb( zaos, zacs ) 
    … …  
    854856      ENDIF 
    855857      !                                                      ! ------------------------- ! 
    856       !                                                      !  Ice fraction & Thickness !  
     858      !                                                      !  Ice fraction & Thickness ! 
    857859      !                                                      ! ------------------------- ! 
    858860      ssnd(jps_fice)%clname  = 'OIceFrc' 
    859       ssnd(jps_ficet)%clname = 'OIceFrcT'  
     861      ssnd(jps_ficet)%clname = 'OIceFrcT' 
    860862      ssnd(jps_hice)%clname  = 'OIceTck' 
    861863      ssnd(jps_a_p)%clname   = 'OPndFrc' 
    … …  
    870872         IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 
    871873      ENDIF 
    872        
    873       IF(TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE.  
     874 
     875      IF(TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 
    874876 
    875877      SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 
    876878      CASE( 'none'         )       ! nothing to do 
    877       CASE( 'ice and snow' )  
     879      CASE( 'ice and snow' ) 
    878880         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
    879881         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
    880882            ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 
    881883         ENDIF 
    882       CASE ( 'weighted ice and snow' )  
     884      CASE ( 'weighted ice and snow' ) 
    883885         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
    884886         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 
    … …  
    890892       a_i_last_couple(:,:,:) = 0._wp 
    891893#endif 
    892       !                                                      ! ------------------------- !  
    893       !                                                      !      Ice Meltponds        !  
    894       !                                                      ! ------------------------- !  
     894      !                                                      ! ------------------------- ! 
     895      !                                                      !      Ice Meltponds        ! 
     896      !                                                      ! ------------------------- ! 
    895897      ! Needed by Met Office 
    896       ssnd(jps_a_p)%clname  = 'OPndFrc'     
    897       ssnd(jps_ht_p)%clname = 'OPndTck'     
    898       SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) )  
    899       CASE ( 'none' )  
    900          ssnd(jps_a_p)%laction  = .FALSE.  
    901          ssnd(jps_ht_p)%laction = .FALSE.  
    902       CASE ( 'ice only' )   
    903          ssnd(jps_a_p)%laction  = .TRUE.  
    904          ssnd(jps_ht_p)%laction = .TRUE.  
    905          IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
    906             ssnd(jps_a_p)%nct  = nn_cats_cpl  
    907             ssnd(jps_ht_p)%nct = nn_cats_cpl  
    908          ELSE  
    909             IF( nn_cats_cpl > 1 ) THEN  
    910                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' )  
    911             ENDIF  
    912          ENDIF  
    913       CASE ( 'weighted ice' )   
    914          ssnd(jps_a_p)%laction  = .TRUE.  
    915          ssnd(jps_ht_p)%laction = .TRUE.  
    916          IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
    917             ssnd(jps_a_p)%nct  = nn_cats_cpl   
    918             ssnd(jps_ht_p)%nct = nn_cats_cpl   
    919          ENDIF  
    920       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes )  
    921       END SELECT  
    922   
     898      ssnd(jps_a_p)%clname  = 'OPndFrc' 
     899      ssnd(jps_ht_p)%clname = 'OPndTck' 
     900      SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 
     901      CASE ( 'none' ) 
     902         ssnd(jps_a_p)%laction  = .FALSE. 
     903         ssnd(jps_ht_p)%laction = .FALSE. 
     904      CASE ( 'ice only' ) 
     905         ssnd(jps_a_p)%laction  = .TRUE. 
     906         ssnd(jps_ht_p)%laction = .TRUE. 
     907         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
     908            ssnd(jps_a_p)%nct  = nn_cats_cpl 
     909            ssnd(jps_ht_p)%nct = nn_cats_cpl 
     910         ELSE 
     911            IF( nn_cats_cpl > 1 ) THEN 
     912               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 
     913            ENDIF 
     914         ENDIF 
     915      CASE ( 'weighted ice' ) 
     916         ssnd(jps_a_p)%laction  = .TRUE. 
     917         ssnd(jps_ht_p)%laction = .TRUE. 
     918         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
     919            ssnd(jps_a_p)%nct  = nn_cats_cpl 
     920            ssnd(jps_ht_p)%nct = nn_cats_cpl 
     921         ENDIF 
     922      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes ) 
     923      END SELECT 
     924 
    923925      !                                                      ! ------------------------- ! 
    924926      !                                                      !      Surface current      ! 
    … …  
    928930      ssnd(jps_ocy1)%clname = 'O_OCury1'   ;   ssnd(jps_ivy1)%clname = 'O_IVely1' 
    929931      ssnd(jps_ocz1)%clname = 'O_OCurz1'   ;   ssnd(jps_ivz1)%clname = 'O_IVelz1' 
    930       ssnd(jps_ocxw)%clname = 'O_OCurxw'  
    931       ssnd(jps_ocyw)%clname = 'O_OCuryw'  
     932      ssnd(jps_ocxw)%clname = 'O_OCurxw' 
     933      ssnd(jps_ocyw)%clname = 'O_OCuryw' 
    932934      ! 
    933935      ssnd(jps_ocx1:jps_ivz1)%nsgn = -1.   ! vectors: change of the sign at the north fold 
    … …  
    935937      IF( sn_snd_crt%clvgrd == 'U,V' ) THEN 
    936938         ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V' 
    937       ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN   
     939      ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 
    938940         CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 
    939941      ENDIF 
    940942      ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE.   ! default: all are send 
    941       IF( TRIM( sn_snd_crt%clvref ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE.  
     943      IF( TRIM( sn_snd_crt%clvref ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 
    942944      IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1. 
    943945      SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    … …  
    949951      END SELECT 
    950952 
    951       ssnd(jps_ocxw:jps_ocyw)%nsgn = -1.   ! vectors: change of the sign at the north fold  
    952          
    953       IF( sn_snd_crtw%clvgrd == 'U,V' ) THEN  
    954          ssnd(jps_ocxw)%clgrid = 'U' ; ssnd(jps_ocyw)%clgrid = 'V'  
    955       ELSE IF( sn_snd_crtw%clvgrd /= 'T' ) THEN  
    956          CALL ctl_stop( 'sn_snd_crtw%clvgrd must be equal to T' )  
    957       ENDIF  
    958       IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) ssnd(jps_ocxw:jps_ocyw)%nsgn = 1.  
    959       SELECT CASE( TRIM( sn_snd_crtw%cldes ) )  
    960          CASE( 'none'                 )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .FALSE.  
    961          CASE( 'oce only'             )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .TRUE.  
    962          CASE( 'weighted oce and ice' )   !   nothing to do  
    963          CASE( 'mixed oce-ice'        )   ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.  
    964          CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crtw%cldes' )  
    965       END SELECT  
     953      ssnd(jps_ocxw:jps_ocyw)%nsgn = -1.   ! vectors: change of the sign at the north fold 
     954 
     955      IF( sn_snd_crtw%clvgrd == 'U,V' ) THEN 
     956         ssnd(jps_ocxw)%clgrid = 'U' ; ssnd(jps_ocyw)%clgrid = 'V' 
     957      ELSE IF( sn_snd_crtw%clvgrd /= 'T' ) THEN 
     958         CALL ctl_stop( 'sn_snd_crtw%clvgrd must be equal to T' ) 
     959      ENDIF 
     960      IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) ssnd(jps_ocxw:jps_ocyw)%nsgn = 1. 
     961      SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
     962         CASE( 'none'                 )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .FALSE. 
     963         CASE( 'oce only'             )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .TRUE. 
     964         CASE( 'weighted oce and ice' )   !   nothing to do 
     965         CASE( 'mixed oce-ice'        )   ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 
     966         CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crtw%cldes' ) 
     967      END SELECT 
    966968 
    967969      !                                                      ! ------------------------- ! 
    … …  
    969971      !                                                      ! ------------------------- ! 
    970972      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
    971       !  
    972       !                                                      ! ------------------------- !  
    973       !                                                      ! Sea surface freezing temp !  
    974       !                                                      ! ------------------------- !  
     973      ! 
     974      !                                                      ! ------------------------- ! 
     975      !                                                      ! Sea surface freezing temp ! 
     976      !                                                      ! ------------------------- ! 
    975977      ! needed by Met Office 
    976       ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' )  ssnd(jps_sstfrz)%laction = .TRUE.  
    977       !  
    978       !                                                      ! ------------------------- !  
    979       !                                                      !    Ice conductivity       !  
    980       !                                                      ! ------------------------- !  
     978      ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' )  ssnd(jps_sstfrz)%laction = .TRUE. 
     979      ! 
     980      !                                                      ! ------------------------- ! 
     981      !                                                      !    Ice conductivity       ! 
     982      !                                                      ! ------------------------- ! 
    981983      ! needed by Met Office 
    982       ! Note that ultimately we will move to passing an ocean effective conductivity as well so there  
    983       ! will be some changes to the parts of the code which currently relate only to ice conductivity  
    984       ssnd(jps_ttilyr )%clname = 'O_TtiLyr'  
    985       SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) )  
    986       CASE ( 'none' )  
    987          ssnd(jps_ttilyr)%laction = .FALSE.  
    988       CASE ( 'ice only' )  
    989          ssnd(jps_ttilyr)%laction = .TRUE.  
    990          IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN  
    991             ssnd(jps_ttilyr)%nct = nn_cats_cpl  
    992          ELSE  
    993             IF( nn_cats_cpl > 1 ) THEN  
    994                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' )  
    995             ENDIF  
    996          ENDIF  
    997       CASE ( 'weighted ice' )  
    998          ssnd(jps_ttilyr)%laction = .TRUE.  
    999          IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl  
    1000       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes )  
    1001       END SELECT  
    1002  
    1003       ssnd(jps_kice )%clname = 'OIceKn'  
    1004       SELECT CASE ( TRIM( sn_snd_cond%cldes ) )  
    1005       CASE ( 'none' )  
    1006          ssnd(jps_kice)%laction = .FALSE.  
    1007       CASE ( 'ice only' )  
    1008          ssnd(jps_kice)%laction = .TRUE.  
    1009          IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN  
    1010             ssnd(jps_kice)%nct = nn_cats_cpl  
    1011          ELSE  
    1012             IF( nn_cats_cpl > 1 ) THEN  
    1013                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' )  
    1014             ENDIF  
    1015          ENDIF  
    1016       CASE ( 'weighted ice' )  
    1017          ssnd(jps_kice)%laction = .TRUE.  
    1018          IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl  
    1019       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes )  
    1020       END SELECT  
    1021       !  
    1022       !                                                      ! ------------------------- !  
    1023       !                                                      !     Sea surface height    !  
    1024       !                                                      ! ------------------------- !  
    1025       ssnd(jps_wlev)%clname = 'O_Wlevel' ;  IF( TRIM(sn_snd_wlev%cldes) == 'coupled' )   ssnd(jps_wlev)%laction = .TRUE.  
     984      ! Note that ultimately we will move to passing an ocean effective conductivity as well so there 
     985      ! will be some changes to the parts of the code which currently relate only to ice conductivity 
     986      ssnd(jps_ttilyr )%clname = 'O_TtiLyr' 
     987      SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) ) 
     988      CASE ( 'none' ) 
     989         ssnd(jps_ttilyr)%laction = .FALSE. 
     990      CASE ( 'ice only' ) 
     991         ssnd(jps_ttilyr)%laction = .TRUE. 
     992         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 
     993            ssnd(jps_ttilyr)%nct = nn_cats_cpl 
     994         ELSE 
     995            IF( nn_cats_cpl > 1 ) THEN 
     996               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 
     997            ENDIF 
     998         ENDIF 
     999      CASE ( 'weighted ice' ) 
     1000         ssnd(jps_ttilyr)%laction = .TRUE. 
     1001         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 
     1002      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 
     1003      END SELECT 
     1004 
     1005      ssnd(jps_kice )%clname = 'OIceKn' 
     1006      SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 
     1007      CASE ( 'none' ) 
     1008         ssnd(jps_kice)%laction = .FALSE. 
     1009      CASE ( 'ice only' ) 
     1010         ssnd(jps_kice)%laction = .TRUE. 
     1011         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 
     1012            ssnd(jps_kice)%nct = nn_cats_cpl 
     1013         ELSE 
     1014            IF( nn_cats_cpl > 1 ) THEN 
     1015               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 
     1016            ENDIF 
     1017         ENDIF 
     1018      CASE ( 'weighted ice' ) 
     1019         ssnd(jps_kice)%laction = .TRUE. 
     1020         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 
     1021      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 
     1022      END SELECT 
     1023      ! 
     1024      !                                                      ! ------------------------- ! 
     1025      !                                                      !     Sea surface height    ! 
     1026      !                                                      ! ------------------------- ! 
     1027      ssnd(jps_wlev)%clname = 'O_Wlevel' ;  IF( TRIM(sn_snd_wlev%cldes) == 'coupled' )   ssnd(jps_wlev)%laction = .TRUE. 
    10261028 
    10271029      !                                                      ! ------------------------------- ! 
    1028       !                                                      !   OPA-SAS coupling - snd by opa !    
     1030      !                                                      !   OPA-SAS coupling - snd by opa ! 
    10291031      !                                                      ! ------------------------------- ! 
    1030       ssnd(jps_ssh   )%clname = 'O_SSHght'  
    1031       ssnd(jps_soce  )%clname = 'O_SSSal'  
    1032       ssnd(jps_e3t1st)%clname = 'O_E3T1st'    
     1032      ssnd(jps_ssh   )%clname = 'O_SSHght' 
     1033      ssnd(jps_soce  )%clname = 'O_SSSal' 
     1034      ssnd(jps_e3t1st)%clname = 'O_E3T1st' 
    10331035      ssnd(jps_fraqsr)%clname = 'O_FraQsr' 
    10341036      ! 
    … …  
    10481050            WRITE(numout,*)'  sent fields to SAS component ' 
    10491051            WRITE(numout,*)'               sea surface temperature (T before, Celsius) ' 
    1050             WRITE(numout,*)'               sea surface salinity '  
    1051             WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates'  
    1052             WRITE(numout,*)'               sea surface height '  
    1053             WRITE(numout,*)'               thickness of first ocean T level '         
     1052            WRITE(numout,*)'               sea surface salinity ' 
     1053            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates' 
     1054            WRITE(numout,*)'               sea surface height ' 
     1055            WRITE(numout,*)'               thickness of first ocean T level ' 
    10541056            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
    10551057            WRITE(numout,*) 
    … …  
    10571059      ENDIF 
    10581060      !                                                      ! ------------------------------- ! 
    1059       !                                                      !   OPA-SAS coupling - snd by sas !    
     1061      !                                                      !   OPA-SAS coupling - snd by sas ! 
    10601062      !                                                      ! ------------------------------- ! 
    1061       ssnd(jps_sflx  )%clname = 'I_SFLX'      
     1063      ssnd(jps_sflx  )%clname = 'I_SFLX' 
    10621064      ssnd(jps_fice2 )%clname = 'IIceFrc' 
    1063       ssnd(jps_qsroce)%clname = 'I_QsrOce'    
    1064       ssnd(jps_qnsoce)%clname = 'I_QnsOce'    
    1065       ssnd(jps_oemp  )%clname = 'IOEvaMPr'  
    1066       ssnd(jps_otx1  )%clname = 'I_OTaux1'    
    1067       ssnd(jps_oty1  )%clname = 'I_OTauy1'    
    1068       ssnd(jps_rnf   )%clname = 'I_Runoff'    
    1069       ssnd(jps_taum  )%clname = 'I_TauMod'    
     1065      ssnd(jps_qsroce)%clname = 'I_QsrOce' 
     1066      ssnd(jps_qnsoce)%clname = 'I_QnsOce' 
     1067      ssnd(jps_oemp  )%clname = 'IOEvaMPr' 
     1068      ssnd(jps_otx1  )%clname = 'I_OTaux1' 
     1069      ssnd(jps_oty1  )%clname = 'I_OTauy1' 
     1070      ssnd(jps_rnf   )%clname = 'I_Runoff' 
     1071      ssnd(jps_taum  )%clname = 'I_TauMod' 
    10701072      ! 
    10711073      IF( nn_components == jp_iam_sas ) THEN 
    … …  
    11021104      ! ================================ ! 
    11031105      CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 
    1104        
    1105       IF(ln_usecplmask) THEN  
     1106 
     1107      IF(ln_usecplmask) THEN 
    11061108         xcplmask(:,:,:) = 0. 
    11071109         CALL iom_open( 'cplmask', inum ) 
    … …  
    11181120 
    11191121 
    1120    SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm )      
     1122   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm ) 
    11211123      !!---------------------------------------------------------------------- 
    11221124      !!             ***  ROUTINE sbc_cpl_rcv  *** 
    … …  
    11321134      !! 
    11331135      !!                  - transform the received ocean stress vector from the received 
    1134       !!                 referential and grid into an atmosphere-ocean stress in  
    1135       !!                 the (i,j) ocean referencial and at the ocean velocity point.  
     1136      !!                 referential and grid into an atmosphere-ocean stress in 
     1137      !!                 the (i,j) ocean referencial and at the ocean velocity point. 
    11361138      !!                    The received stress are : 
    11371139      !!                     - defined by 3 components (if cartesian coordinate) 
    … …  
    11411143      !!                     - given at U- and V-point, resp.   if received on 2 grids 
    11421144      !!                            or at T-point               if received on 1 grid 
    1143       !!                    Therefore and if necessary, they are successively  
    1144       !!                  processed in order to obtain them  
    1145       !!                     first  as  2 components on the sphere  
     1145      !!                    Therefore and if necessary, they are successively 
     1146      !!                  processed in order to obtain them 
     1147      !!                     first  as  2 components on the sphere 
    11461148      !!                     second as  2 components oriented along the local grid 
    1147       !!                     third  as  2 components on the U,V grid  
     1149      !!                     third  as  2 components on the U,V grid 
    11481150      !! 
    1149       !!              -->  
     1151      !!              --> 
    11501152      !! 
    1151       !!              - In 'ocean only' case, non solar and solar ocean heat fluxes  
    1152       !!             and total ocean freshwater fluxes   
     1153      !!              - In 'ocean only' case, non solar and solar ocean heat fluxes 
     1154      !!             and total ocean freshwater fluxes 
    11531155      !! 
    1154       !! ** Method  :   receive all fields from the atmosphere and transform  
    1155       !!              them into ocean surface boundary condition fields  
     1156      !! ** Method  :   receive all fields from the atmosphere and transform 
     1157      !!              them into ocean surface boundary condition fields 
    11561158      !! 
    1157       !! ** Action  :   update  utau, vtau   ocean stress at U,V grid  
     1159      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid 
    11581160      !!                        taum         wind stress module at T-point 
    11591161      !!                        wndm         wind speed  module at T-point over free ocean or leads in presence of sea-ice 
    … …  
    11661168      ! 
    11671169      INTEGER, INTENT(in) ::   kt          ! ocean model time step index 
    1168       INTEGER, INTENT(in) ::   k_fsbc      ! frequency of sbc (-> ice model) computation  
     1170      INTEGER, INTENT(in) ::   k_fsbc      ! frequency of sbc (-> ice model) computation 
    11691171      INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
    11701172      INTEGER, INTENT(in) ::   Kbb, Kmm    ! ocean model time level indices 
    … …  
    11731175      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    11741176      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdt did not change since nit000) 
    1175       REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
     1177      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars 
    11761178      REAL(wp) ::   zcoef                  ! temporary scalar 
    11771179      REAL(wp) ::   zrhoa  = 1.22          ! Air density kg/m3 
    … …  
    11881190 
    11891191         IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 
    1190           
     1192 
    11911193         IF ( ln_wave .AND. nn_components == 0 ) THEN 
    11921194            ncpl_qsr_freq = 1; 
    … …  
    12311233            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    12321234               !                                                       ! (geographical to local grid -> rotate the components) 
    1233                CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
     1235               CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 
    12341236               IF( srcv(jpr_otx2)%laction ) THEN 
    1235                   CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
     1237                  CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 
    12361238               ELSE 
    1237                   CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
     1239                  CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 
    12381240               ENDIF 
    12391241               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    12401242               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    12411243            ENDIF 
    1242             !                               
     1244            ! 
    12431245            IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 
    12441246               DO_2D( 0, 0, 0, 0 )                                        ! T ==> (U,V) 
    … …  
    12551257      ELSE                                                   !   No dynamical coupling   ! 
    12561258         !                                                   ! ========================= ! 
    1257          frcv(jpr_otx1)%z3(:,:,1) = 0.e0                               ! here simply set to zero  
     1259         frcv(jpr_otx1)%z3(:,:,1) = 0.e0                               ! here simply set to zero 
    12581260         frcv(jpr_oty1)%z3(:,:,1) = 0.e0                               ! an external read in a file can be added instead 
    12591261         llnewtx = .TRUE. 
    … …  
    12631265      !                                                      !    wind stress module     !   (taum) 
    12641266      !                                                      ! ========================= ! 
    1265       IF( .NOT. srcv(jpr_taum)%laction ) THEN                    ! compute wind stress module from its components if not received  
     1267      IF( .NOT. srcv(jpr_taum)%laction ) THEN                    ! compute wind stress module from its components if not received 
    12661268         ! => need to be done only when otx1 was changed 
    12671269         IF( llnewtx ) THEN 
    … …  
    12791281         llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv 
    12801282         ! Stress module can be negative when received (interpolation problem) 
    1281          IF( llnewtau ) THEN  
     1283         IF( llnewtau ) THEN 
    12821284            frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) ) 
    12831285         ENDIF 
    … …  
    12871289      !                                                      !      10 m wind speed      !   (wndm) 
    12881290      !                                                      ! ========================= ! 
    1289       IF( .NOT. srcv(jpr_w10m)%laction ) THEN                    ! compute wind spreed from wind stress module if not received   
     1291      IF( .NOT. srcv(jpr_w10m)%laction ) THEN                    ! compute wind spreed from wind stress module if not received 
    12901292         ! => need to be done only when taumod was changed 
    1291          IF( llnewtau ) THEN  
    1292             zcoef = 1. / ( zrhoa * zcdrag )  
     1293         IF( llnewtau ) THEN 
     1294            zcoef = 1. / ( zrhoa * zcdrag ) 
    12931295            DO_2D( 1, 1, 1, 1 ) 
    12941296               frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    … …  
    13101312      !                                                      ! ========================= ! 
    13111313      ! u(v)tau and taum will be modified by ice model 
    1312       ! -> need to be reset before each call of the ice/fsbc       
     1314      ! -> need to be reset before each call of the ice/fsbc 
    13131315      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 
    13141316         ! 
    … …  
    13251327         ENDIF 
    13261328         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    1327          !   
     1329         ! 
    13281330      ENDIF 
    13291331 
    … …  
    13331335      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
    13341336      ! 
    1335       !                                                      ! ========================= !  
    1336       !                                                      ! Mean Sea Level Pressure   !   (taum)  
    1337       !                                                      ! ========================= !  
    1338       IF( srcv(jpr_mslp)%laction ) THEN                    ! UKMO SHELF effect of atmospheric pressure on SSH  
    1339           IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields  
    1340  
    1341           r1_grau = 1.e0 / (grav * rho0)               !* constant for optimization  
    1342           ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer)  
    1343           apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                         !atmospheric pressure  
    1344      
    1345           IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible)  
    1346       ENDIF  
     1337      !                                                      ! ========================= ! 
     1338      !                                                      ! Mean Sea Level Pressure   !   (taum) 
     1339      !                                                      ! ========================= ! 
     1340      IF( srcv(jpr_mslp)%laction ) THEN                    ! UKMO SHELF effect of atmospheric pressure on SSH 
     1341          IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields 
     1342 
     1343          r1_grau = 1.e0 / (grav * rho0)               !* constant for optimization 
     1344          ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer) 
     1345          apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                         !atmospheric pressure 
     1346 
     1347          IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible) 
     1348      ENDIF 
    13471349      ! 
    13481350      IF( ln_sdw ) THEN  ! Stokes Drift correction activated 
    1349       !                                                      ! ========================= !  
     1351      !                                                      ! ========================= ! 
    13501352      !                                                      !       Stokes drift u      ! 
    1351       !                                                      ! ========================= !  
     1353      !                                                      ! ========================= ! 
    13521354         IF( srcv(jpr_sdrftx)%laction ) ut0sd(:,:) = frcv(jpr_sdrftx)%z3(:,:,1) 
    13531355      ! 
    1354       !                                                      ! ========================= !  
     1356      !                                                      ! ========================= ! 
    13551357      !                                                      !       Stokes drift v      ! 
    1356       !                                                      ! ========================= !  
     1358      !                                                      ! ========================= ! 
    13571359         IF( srcv(jpr_sdrfty)%laction ) vt0sd(:,:) = frcv(jpr_sdrfty)%z3(:,:,1) 
    13581360      ! 
    1359       !                                                      ! ========================= !  
     1361      !                                                      ! ========================= ! 
    13601362      !                                                      !      Wave mean period     ! 
    1361       !                                                      ! ========================= !  
     1363      !                                                      ! ========================= ! 
    13621364         IF( srcv(jpr_wper)%laction ) wmp(:,:) = frcv(jpr_wper)%z3(:,:,1) 
    13631365      ! 
    1364       !                                                      ! ========================= !  
     1366      !                                                      ! ========================= ! 
    13651367      !                                                      !  Significant wave height  ! 
    1366       !                                                      ! ========================= !  
     1368      !                                                      ! ========================= ! 
    13671369         IF( srcv(jpr_hsig)%laction ) hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1) 
    1368       !  
    1369       !                                                      ! ========================= !  
     1370      ! 
     1371      !                                                      ! ========================= ! 
    13701372      !                                                      !    Vertical mixing Qiao   ! 
    1371       !                                                      ! ========================= !  
     1373      !                                                      ! ========================= ! 
    13721374         IF( srcv(jpr_wnum)%laction .AND. ln_zdfswm ) wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1) 
    13731375 
    … …  
    13781380         ENDIF 
    13791381      ENDIF 
    1380       !                                                      ! ========================= !  
     1382      !                                                      ! ========================= ! 
    13811383      !                                                      ! Stress adsorbed by waves  ! 
    1382       !                                                      ! ========================= !  
     1384      !                                                      ! ========================= ! 
    13831385      IF( srcv(jpr_wstrf)%laction .AND. ln_tauoc )  tauoc_wave(:,:) = frcv(jpr_wstrf)%z3(:,:,1) 
    13841386      ! 
    1385       !                                                      ! ========================= !  
     1387      !                                                      ! ========================= ! 
    13861388      !                                                      !   Wave drag coefficient   ! 
    1387       !                                                      ! ========================= !  
     1389      !                                                      ! ========================= ! 
    13881390      IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw )   cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1) 
    13891391      ! 
    … …  
    14041406      IF( srcv(jpr_twox)%laction .AND. ln_taw )     twox(:,:) = frcv(jpr_twox)%z3(:,:,1) 
    14051407      IF( srcv(jpr_twoy)%laction .AND. ln_taw )     twoy(:,:) = frcv(jpr_twoy)%z3(:,:,1) 
    1406       !                                                       
     1408      ! 
    14071409      !                                                      ! ========================= ! 
    14081410      !                                                      !    wave TKE flux at sfc   ! 
    … …  
    14341436         CALL iom_put( 'sss_m', sss_m ) 
    14351437      ENDIF 
    1436       !                                                
     1438      ! 
    14371439      !                                                      ! ================== ! 
    14381440      !                                                      !        SST         ! 
    … …  
    14801482         CALL iom_put( 'frq_m', frq_m ) 
    14811483      ENDIF 
    1482        
     1484 
    14831485      !                                                      ! ========================= ! 
    14841486      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case) 
    … …  
    15021504         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
    15031505         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    1504   
    1505          IF( srcv(jpr_icb)%laction )  THEN  
     1506 
     1507         IF( srcv(jpr_icb)%laction )  THEN 
    15061508             fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 
    15071509             rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runfofs 
    … …  
    15101512         ! ice shelf fwf 
    15111513         IF( srcv(jpr_isf)%laction )  THEN 
    1512             fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)   
     1514            fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting) 
    15131515         END IF 
    1514          
     1516 
    15151517         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 
    15161518         ELSE                   ;   emp(:,:) =                              zemp(:,:) 
    … …  
    15541556      ! 
    15551557   END SUBROUTINE sbc_cpl_rcv 
    1556     
    1557  
    1558    SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )      
     1558 
     1559 
     1560   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj ) 
    15591561      !!---------------------------------------------------------------------- 
    15601562      !!             ***  ROUTINE sbc_cpl_ice_tau  *** 
    15611563      !! 
    1562       !! ** Purpose :   provide the stress over sea-ice in coupled mode  
     1564      !! ** Purpose :   provide the stress over sea-ice in coupled mode 
    15631565      !! 
    15641566      !! ** Method  :   transform the received stress from the atmosphere into 
    15651567      !!             an atmosphere-ice stress in the (i,j) ocean referencial 
    15661568      !!             and at the velocity point of the sea-ice model: 
    1567       !!                'C'-grid : i- (j-) components given at U- (V-) point  
     1569      !!                'C'-grid : i- (j-) components given at U- (V-) point 
    15681570      !! 
    15691571      !!                The received stress are : 
    … …  
    15741576      !!                 - given at U- and V-point, resp.   if received on 2 grids 
    15751577      !!                        or at a same point (T or I) if received on 1 grid 
    1576       !!                Therefore and if necessary, they are successively  
    1577       !!             processed in order to obtain them  
    1578       !!                 first  as  2 components on the sphere  
     1578      !!                Therefore and if necessary, they are successively 
     1579      !!             processed in order to obtain them 
     1580      !!                 first  as  2 components on the sphere 
    15791581      !!                 second as  2 components oriented along the local grid 
    1580       !!                 third  as  2 components on the ice grid point  
     1582      !!                 third  as  2 components on the ice grid point 
    15811583      !! 
    1582       !!                Except in 'oce and ice' case, only one vector stress field  
     1584      !!                Except in 'oce and ice' case, only one vector stress field 
    15831585      !!             is received. It has already been processed in sbc_cpl_rcv 
    15841586      !!             so that it is now defined as (i,j) components given at U- 
    1585       !!             and V-points, respectively.   
     1587      !!             and V-points, respectively. 
    15861588      !! 
    15871589      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice 
    … …  
    15931595      INTEGER ::   itx      ! index of taux over ice 
    15941596      REAL(wp)                     ::   zztmp1, zztmp2 
    1595       REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty  
     1597      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty 
    15961598      !!---------------------------------------------------------------------- 
    15971599      ! 
    1598       IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
     1600      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1 
    15991601      ELSE                                ;   itx =  jpr_otx1 
    16001602      ENDIF 
    … …  
    16051607         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   ! 
    16061608            !                                                   ! ======================= ! 
    1607             !   
     1609            ! 
    16081610            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
    16091611               !                                                       ! (cartesian to spherical -> 3 to 2 components) 
    … …  
    16241626            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    16251627               !                                                       ! (geographical to local grid -> rotate the components) 
    1626                CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )    
     1628               CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx ) 
    16271629               IF( srcv(jpr_itx2)%laction ) THEN 
    1628                   CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )    
     1630                  CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty ) 
    16291631               ELSE 
    1630                   CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )   
     1632                  CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 
    16311633               ENDIF 
    16321634               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    … …  
    16431645         !                                                      !     put on ice grid     ! 
    16441646         !                                                      ! ======================= ! 
    1645          !     
     1647         ! 
    16461648         !                                                  j+1   j     -----V---F 
    16471649         ! ice stress on ice velocity point                              !       | 
    … …  
    16581660         CASE( 'T' ) 
    16591661            DO_2D( 0, 0, 0, 0 )                    ! T ==> (U,V) 
    1660                ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology  
     1662               ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology 
    16611663               zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
    16621664               zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) ) 
    … …  
    16661668            CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. ) 
    16671669         END SELECT 
    1668           
     1670 
    16691671      ENDIF 
    16701672      ! 
    16711673   END SUBROUTINE sbc_cpl_ice_tau 
    1672     
     1674 
    16731675 
    16741676   SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi ) 
    … …  
    16791681      !! 
    16801682      !! ** Method  :   transform the fields received from the atmosphere into 
    1681       !!             surface heat and fresh water boundary condition for the  
     1683      !!             surface heat and fresh water boundary condition for the 
    16821684      !!             ice-ocean system. The following fields are provided: 
    1683       !!               * total non solar, solar and freshwater fluxes (qns_tot,  
     1685      !!               * total non solar, solar and freshwater fluxes (qns_tot, 
    16841686      !!             qsr_tot and emp_tot) (total means weighted ice-ocean flux) 
    16851687      !!             NB: emp_tot include runoffs and calving. 
    16861688      !!               * fluxes over ice (qns_ice, qsr_ice, emp_ice) where 
    16871689      !!             emp_ice = sublimation - solid precipitation as liquid 
    1688       !!             precipitation are re-routed directly to the ocean and  
     1690      !!             precipitation are re-routed directly to the ocean and 
    16891691      !!             calving directly enter the ocean (runoffs are read but included in trasbc.F90) 
    1690       !!               * solid precipitation (sprecip), used to add to qns_tot  
     1692      !!               * solid precipitation (sprecip), used to add to qns_tot 
    16911693      !!             the heat lost associated to melting solid precipitation 
    16921694      !!             over the ocean fraction. 
    … …  
    17201722      !!                   emp_ice           ice sublimation - solid precipitation over the ice 
    17211723      !!                   dqns_ice          d(non-solar heat flux)/d(Temperature) over the ice 
    1722       !!                   sprecip           solid precipitation over the ocean   
     1724      !!                   sprecip           solid precipitation over the ocean 
    17231725      !!---------------------------------------------------------------------- 
    17241726      REAL(wp), INTENT(in)   , DIMENSION(:,:)             ::   picefr     ! ice fraction                [0 to 1] 
    17251727      !                                                   !!           ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling 
    1726       REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo  
     1728      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo 
    17271729      REAL(wp), INTENT(in)   , DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius] 
    17281730      REAL(wp), INTENT(inout), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] => inout for Met-Office 
    … …  
    17611763         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 
    17621764         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 
    1763       CASE( 'none'      )       ! Not available as for now: needs additional coding below when computing zevap_oce  
     1765      CASE( 'none'      )       ! Not available as for now: needs additional coding below when computing zevap_oce 
    17641766      !                         ! since fields received are not defined with none option 
    17651767         CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_emp value in namelist namsbc_cpl' ) 
    … …  
    18081810      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 
    18091811      zsnw(:,:) = 0._wp   ;   CALL ice_var_snwblow( ziceld, zsnw ) 
    1810        
     1812 
    18111813      ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 
    18121814      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) )  ! emp_ice = A * sublimation - zsnw * sprecip 
    … …  
    18191821      ! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm. 
    18201822      zdevap_ice(:,:) = 0._wp 
    1821        
     1823 
    18221824      ! --- Continental fluxes --- ! 
    18231825      IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on) 
    … …  
    18331835      ENDIF 
    18341836      IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting) 
    1835         fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)   
     1837        fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 
    18361838      ENDIF 
    18371839 
    … …  
    18491851         emp_tot (:,:)   = zemp_tot (:,:) 
    18501852         emp_ice (:,:)   = zemp_ice (:,:) 
    1851          emp_oce (:,:)   = zemp_oce (:,:)      
     1853         emp_oce (:,:)   = zemp_oce (:,:) 
    18521854         sprecip (:,:)   = zsprecip (:,:) 
    18531855         tprecip (:,:)   = ztprecip (:,:) 
    … …  
    18961898      IF( iom_use('snowpre') )       CALL iom_put( 'snowpre'     , sprecip(:,:)                                          )  ! Snow 
    18971899      IF( iom_use('precip') )        CALL iom_put( 'precip'      , tprecip(:,:)                                          )  ! total  precipitation 
    1898       IF( iom_use('rain') )          CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation  
     1900      IF( iom_use('rain') )          CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation 
    18991901      IF( iom_use('snow_ao_cea') )   CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average) 
    19001902      IF( iom_use('snow_ai_cea') )   CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average) 
    … …  
    19121914         ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 
    19131915         ! here so the only flux is the ocean only one. 
    1914          zqns_ice(:,:,:) = 0._wp  
     1916         zqns_ice(:,:,:) = 0._wp 
    19151917      CASE( 'conservative' )     ! the required fields are directly provided 
    19161918         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    … …  
    19261928         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    19271929            DO jl=1,jpl 
    1928                zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
     1930               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 
    19291931               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
    19301932            ENDDO 
    … …  
    19521954         ENDIF 
    19531955      END SELECT 
    1954       !                                      
     1956      ! 
    19551957      ! --- calving (removed from qns_tot) --- ! 
    19561958      IF( srcv(jpr_cal)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus  ! remove latent heat of calving 
    … …  
    19591961      IF( srcv(jpr_icb)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus  ! remove latent heat of iceberg melting 
    19601962 
    1961 #if defined key_si3       
     1963#if defined key_si3 
    19621964      ! --- non solar flux over ocean --- ! 
    19631965      !         note: ziceld cannot be = 0 since we limit the ice concentration to amax 
    … …  
    19701972      ENDWHERE 
    19711973      ! Heat content per unit mass of rain (J/kg) 
    1972       zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) )  
     1974      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 
    19731975 
    19741976      ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    … …  
    19871989!!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * picefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap 
    19881990!!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhos  ! solid precip over ice 
    1989        
     1991 
    19901992      ! --- total non solar flux (including evap/precip) --- ! 
    19911993      zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:) 
    19921994 
    1993       ! --- in case both coupled/forced are active, we must mix values --- !  
     1995      ! --- in case both coupled/forced are active, we must mix values --- ! 
    19941996      IF( ln_mixcpl ) THEN 
    19951997         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 
    … …  
    20152017      zcptsnw (:,:) = zcptn(:,:) 
    20162018      zcptrain(:,:) = zcptn(:,:) 
    2017        
     2019 
    20182020      ! clem: this formulation is certainly wrong... but better than it was... 
    20192021      zqns_tot(:,:) = zqns_tot(:,:)                             &          ! zqns_tot update over free ocean with: 
    20202022         &          - (  ziceld(:,:) * zsprecip(:,:) * rLfus )  &          ! remove the latent heat flux of solid precip. melting 
    20212023         &          - (  zemp_tot(:,:)                          &          ! remove the heat content of mass flux (assumed to be at SST) 
    2022          &             - zemp_ice(:,:) ) * zcptn(:,:)  
     2024         &             - zemp_ice(:,:) ) * zcptn(:,:) 
    20232025 
    20242026     IF( ln_mixcpl ) THEN 
    … …  
    20452047      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
    20462048           &                                                              * ( 1._wp - zsnw(:,:) )                  )               ! heat flux from snow (over ocean) 
    2047       IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &  
     2049      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
    20482050           &                                                              *           zsnw(:,:)                    )               ! heat flux from snow (over ice) 
    20492051      ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. 
    … …  
    20712073         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    20722074            DO jl = 1, jpl 
    2073                zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
     2075               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 
    20742076               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
    20752077            END DO 
    … …  
    20982100            END DO 
    20992101         ENDIF 
    2100       CASE( 'none'      )       ! Not available as for now: needs additional coding   
     2102      CASE( 'none'      )       ! Not available as for now: needs additional coding 
    21012103      !                         ! since fields received, here zqsr_tot,  are not defined with none option 
    21022104         CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_qsr value in namelist namsbc_cpl' ) 
    … …  
    21422144            ENDDO 
    21432145         ENDIF 
    2144       CASE( 'none' )  
     2146      CASE( 'none' ) 
    21452147         zdqns_ice(:,:,:) = 0._wp 
    21462148      END SELECT 
    2147        
     2149 
    21482150      IF( ln_mixcpl ) THEN 
    21492151         DO jl=1,jpl 
    … …  
    21542156      ENDIF 
    21552157 
    2156 #if defined key_si3       
     2158#if defined key_si3 
    21572159      !                                                      ! ========================= ! 
    21582160      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !  ice topmelt and botmelt  ! 
    … …  
    21862188            ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
    21872189            DO jl = 1, jpl 
    2188                WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
     2190               WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )       ! linear decrease from hi=0 to 10cm 
    21892191                  zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
    21902192               ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )       ! constant (ztri) when hi>10cm 
    21912193                  zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ztri(:,:) 
    21922194               ELSEWHERE                                                           ! zero when hs>0 
    2193                   zqtr_ice_top(:,:,jl) = 0._wp  
     2195                  zqtr_ice_top(:,:,jl) = 0._wp 
    21942196               END WHERE 
    21952197            ENDDO 
    … …  
    22002202            zqtr_ice_top(:,:,:) = 0.3_wp * zqsr_ice(:,:,:) 
    22012203         ENDIF 
    2202          !      
     2204         ! 
    22032205      ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN      !==  conduction flux as surface forcing  ==! 
    22042206         ! 
    … …  
    22202222      !                                                      ! ================== ! 
    22212223      ! needed by Met Office 
    2222       IF( srcv(jpr_ts_ice)%laction ) THEN  
    2223          WHERE    ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0  )   ;   ztsu(:,:,:) =   0. + rt0  
     2224      IF( srcv(jpr_ts_ice)%laction ) THEN 
     2225         WHERE    ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0  )   ;   ztsu(:,:,:) =   0. + rt0 
    22242226         ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. )   ;   ztsu(:,:,:) = -60. + rt0 
    22252227         ELSEWHERE                                        ;   ztsu(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) + rt0 
    … …  
    22392241      ! 
    22402242   END SUBROUTINE sbc_cpl_ice_flx 
    2241     
    2242     
     2243 
     2244 
    22432245   SUBROUTINE sbc_cpl_snd( kt, Kbb, Kmm ) 
    22442246      !!---------------------------------------------------------------------- 
    … …  
    22572259      REAL(wp) ::   zumax, zvmax 
    22582260      REAL(wp), DIMENSION(jpi,jpj)     ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
    2259       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   ztmp3, ztmp4    
     2261      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   ztmp3, ztmp4 
    22602262      !!---------------------------------------------------------------------- 
    22612263      ! 
    … …  
    22682270      !                                                      ! ------------------------- ! 
    22692271      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 
    2270           
     2272 
    22712273         IF( nn_components == jp_iam_opa ) THEN 
    22722274            ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 
    22732275         ELSE 
    2274             ! we must send the surface potential temperature  
     2276            ! we must send the surface potential temperature 
    22752277            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) ) 
    22762278            ELSE                   ;   ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) 
    … …  
    22812283            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0 
    22822284               SELECT CASE( sn_snd_temp%clcat ) 
    2283                CASE( 'yes' )    
     2285               CASE( 'yes' ) 
    22842286                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) 
    22852287               CASE( 'no' ) 
    … …  
    22912293               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
    22922294               END SELECT 
    2293             CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)    
     2295            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
    22942296               SELECT CASE( sn_snd_temp%clcat ) 
    2295                CASE( 'yes' )    
     2297               CASE( 'yes' ) 
    22962298                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    22972299               CASE( 'no' ) 
    … …  
    23022304               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
    23032305               END SELECT 
    2304             CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   ts(:,:,1,jp_tem,Kmm) + rt0   
    2305                SELECT CASE( sn_snd_temp%clcat )  
    2306                CASE( 'yes' )     
    2307                   ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)  
    2308                CASE( 'no' )  
    2309                   ztmp3(:,:,:) = 0.0  
    2310                   DO jl=1,jpl  
    2311                      ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)  
    2312                   ENDDO  
    2313                CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )  
    2314                END SELECT  
    2315             CASE( 'mixed oce-ice'        )    
    2316                ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)  
     2306            CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   ts(:,:,1,jp_tem,Kmm) + rt0 
     2307               SELECT CASE( sn_snd_temp%clcat ) 
     2308               CASE( 'yes' ) 
     2309                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     2310               CASE( 'no' ) 
     2311                  ztmp3(:,:,:) = 0.0 
     2312                  DO jl=1,jpl 
     2313                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     2314                  ENDDO 
     2315               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     2316               END SELECT 
     2317            CASE( 'mixed oce-ice'        ) 
     2318               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
    23172319               DO jl=1,jpl 
    23182320                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    … …  
    23342336         SELECT CASE( sn_snd_ttilyr%cldes) 
    23352337         CASE ('weighted ice') 
    2336             ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl)  
     2338            ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    23372339         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' ) 
    23382340         END SELECT 
    … …  
    23432345      !                                                      !           Albedo          ! 
    23442346      !                                                      ! ------------------------- ! 
    2345       IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
     2347      IF( ssnd(jps_albice)%laction ) THEN                         ! ice 
    23462348          SELECT CASE( sn_snd_alb%cldes ) 
    23472349          CASE( 'ice' ) 
    23482350             SELECT CASE( sn_snd_alb%clcat ) 
    2349              CASE( 'yes' )    
     2351             CASE( 'yes' ) 
    23502352                ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 
    23512353             CASE( 'no' ) 
    … …  
    23592361          CASE( 'weighted ice' )   ; 
    23602362             SELECT CASE( sn_snd_alb%clcat ) 
    2361              CASE( 'yes' )    
     2363             CASE( 'yes' ) 
    23622364                ztmp3(:,:,1:jpl) =  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    23632365             CASE( 'no' ) 
    … …  
    23732375 
    23742376         SELECT CASE( sn_snd_alb%clcat ) 
    2375             CASE( 'yes' )    
     2377            CASE( 'yes' ) 
    23762378               CALL cpl_snd( jps_albice, isec, ztmp3, info )      !-> MV this has never been checked in coupled mode 
    2377             CASE( 'no'  )    
    2378                CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )  
     2379            CASE( 'no'  ) 
     2380               CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    23792381         END SELECT 
    23802382      ENDIF 
    … …  
    23882390      ENDIF 
    23892391      !                                                      ! ------------------------- ! 
    2390       !                                                      !  Ice fraction & Thickness !  
     2392      !                                                      !  Ice fraction & Thickness ! 
    23912393      !                                                      ! ------------------------- ! 
    23922394      ! Send ice fraction field to atmosphere 
    … …  
    24012403 
    24022404#if defined key_si3 || defined key_cice 
    2403       ! If this coupling was successful then save ice fraction for use between coupling points.  
    2404       ! This is needed for some calculations where the ice fraction at the last coupling point  
    2405       ! is needed.  
    2406       IF(  info == OASIS_Sent    .OR. info == OASIS_ToRest .OR. &  
    2407          & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN  
    2408          IF ( sn_snd_thick%clcat == 'yes' ) THEN  
     2405      ! If this coupling was successful then save ice fraction for use between coupling points. 
     2406      ! This is needed for some calculations where the ice fraction at the last coupling point 
     2407      ! is needed. 
     2408      IF(  info == OASIS_Sent    .OR. info == OASIS_ToRest .OR. & 
     2409         & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN 
     2410         IF ( sn_snd_thick%clcat == 'yes' ) THEN 
    24092411           a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 
    24102412         ENDIF 
    … …  
    24202422         CALL cpl_snd( jps_fice1, isec, ztmp3, info ) 
    24212423      ENDIF 
    2422        
     2424 
    24232425      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 
    24242426      IF( ssnd(jps_fice2)%laction ) THEN 
    … …  
    24272429      ENDIF 
    24282430 
    2429       ! Send ice and snow thickness field  
    2430       IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN  
     2431      ! Send ice and snow thickness field 
     2432      IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN 
    24312433         SELECT CASE( sn_snd_thick%cldes) 
    24322434         CASE( 'none'                  )       ! nothing to do 
    2433          CASE( 'weighted ice and snow' )    
     2435         CASE( 'weighted ice and snow' ) 
    24342436            SELECT CASE( sn_snd_thick%clcat ) 
    2435             CASE( 'yes' )    
     2437            CASE( 'yes' ) 
    24362438               ztmp3(:,:,1:jpl) =  h_i(:,:,1:jpl) * a_i(:,:,1:jpl) 
    24372439               ztmp4(:,:,1:jpl) =  h_s(:,:,1:jpl) * a_i(:,:,1:jpl) 
    … …  
    24442446            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
    24452447            END SELECT 
    2446          CASE( 'ice and snow'         )    
     2448         CASE( 'ice and snow'         ) 
    24472449            SELECT CASE( sn_snd_thick%clcat ) 
    24482450            CASE( 'yes' ) 
    … …  
    24672469#if defined key_si3 
    24682470      !                                                      ! ------------------------- ! 
    2469       !                                                      !      Ice melt ponds       !  
    2470       !                                                      ! ------------------------- ! 
    2471       ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth  
    2472       IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN  
    2473          SELECT CASE( sn_snd_mpnd%cldes)   
    2474          CASE( 'ice only' )   
    2475             SELECT CASE( sn_snd_mpnd%clcat )   
    2476             CASE( 'yes' )   
     2471      !                                                      !      Ice melt ponds       ! 
     2472      !                                                      ! ------------------------- ! 
     2473      ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth 
     2474      IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 
     2475         SELECT CASE( sn_snd_mpnd%cldes) 
     2476         CASE( 'ice only' ) 
     2477            SELECT CASE( sn_snd_mpnd%clcat ) 
     2478            CASE( 'yes' ) 
    24772479               ztmp3(:,:,1:jpl) =  a_ip_eff(:,:,1:jpl) 
    2478                ztmp4(:,:,1:jpl) =  h_ip(:,:,1:jpl)   
    2479             CASE( 'no' )   
    2480                ztmp3(:,:,:) = 0.0   
    2481                ztmp4(:,:,:) = 0.0   
    2482                DO jl=1,jpl   
     2480               ztmp4(:,:,1:jpl) =  h_ip(:,:,1:jpl) 
     2481            CASE( 'no' ) 
     2482               ztmp3(:,:,:) = 0.0 
     2483               ztmp4(:,:,:) = 0.0 
     2484               DO jl=1,jpl 
    24832485                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 
    24842486                 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 
    2485                ENDDO   
    2486             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )   
    2487             END SELECT   
    2488          CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%cldes' )      
    2489          END SELECT   
    2490          IF( ssnd(jps_a_p)%laction  )   CALL cpl_snd( jps_a_p , isec, ztmp3, info )      
    2491          IF( ssnd(jps_ht_p)%laction )   CALL cpl_snd( jps_ht_p, isec, ztmp4, info )      
    2492       ENDIF  
    2493       !  
    2494       !                                                      ! ------------------------- ! 
    2495       !                                                      !     Ice conductivity      !  
     2487               ENDDO 
     2488            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) 
     2489            END SELECT 
     2490         CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%cldes' ) 
     2491         END SELECT 
     2492         IF( ssnd(jps_a_p)%laction  )   CALL cpl_snd( jps_a_p , isec, ztmp3, info ) 
     2493         IF( ssnd(jps_ht_p)%laction )   CALL cpl_snd( jps_ht_p, isec, ztmp4, info ) 
     2494      ENDIF 
     2495      ! 
     2496      !                                                      ! ------------------------- ! 
     2497      !                                                      !     Ice conductivity      ! 
    24962498      !                                                      ! ------------------------- ! 
    24972499      ! needed by Met Office 
    2498       IF( ssnd(jps_kice)%laction ) THEN  
    2499          SELECT CASE( sn_snd_cond%cldes)  
    2500          CASE( 'weighted ice' )     
    2501             SELECT CASE( sn_snd_cond%clcat )  
    2502             CASE( 'yes' )     
    2503           ztmp3(:,:,1:jpl) =  cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl)  
    2504             CASE( 'no' )  
    2505                ztmp3(:,:,:) = 0.0  
    2506                DO jl=1,jpl  
    2507                  ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl)  
    2508                ENDDO  
    2509             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' )  
    2510             END SELECT  
    2511          CASE( 'ice only' )     
    2512            ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl)  
    2513          CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%cldes' )      
    2514          END SELECT  
    2515          IF( ssnd(jps_kice)%laction )   CALL cpl_snd( jps_kice, isec, ztmp3, info )  
    2516       ENDIF  
     2500      IF( ssnd(jps_kice)%laction ) THEN 
     2501         SELECT CASE( sn_snd_cond%cldes) 
     2502         CASE( 'weighted ice' ) 
     2503            SELECT CASE( sn_snd_cond%clcat ) 
     2504            CASE( 'yes' ) 
     2505          ztmp3(:,:,1:jpl) =  cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     2506            CASE( 'no' ) 
     2507               ztmp3(:,:,:) = 0.0 
     2508               DO jl=1,jpl 
     2509                 ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl) 
     2510               ENDDO 
     2511            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 
     2512            END SELECT 
     2513         CASE( 'ice only' ) 
     2514           ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) 
     2515         CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%cldes' ) 
     2516         END SELECT 
     2517         IF( ssnd(jps_kice)%laction )   CALL cpl_snd( jps_kice, isec, ztmp3, info ) 
     2518      ENDIF 
    25172519#endif 
    25182520 
    25192521      !                                                      ! ------------------------- ! 
    2520       !                                                      !  CO2 flux from PISCES     !  
    2521       !                                                      ! ------------------------- ! 
    2522       IF( ssnd(jps_co2)%laction .AND. l_co2cpl )   THEN  
     2522      !                                                      !  CO2 flux from PISCES     ! 
     2523      !                                                      ! ------------------------- ! 
     2524      IF( ssnd(jps_co2)%laction .AND. l_co2cpl )   THEN 
    25232525         ztmp1(:,:) = oce_co2(:,:) * 1000.  ! conversion in molC/m2/s 
    25242526         CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info ) 
    … …  
    25282530      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      ! 
    25292531         !                                                   ! ------------------------- ! 
    2530          !     
     2532         ! 
    25312533         !                                                  j+1   j     -----V---F 
    25322534         ! surface velocity always sent from T point                     !       | 
    … …  
    25382540         !                                                               i      i+1 (for I) 
    25392541         IF( nn_components == jp_iam_opa ) THEN 
    2540             zotx1(:,:) = uu(:,:,1,Kmm)   
    2541             zoty1(:,:) = vv(:,:,1,Kmm)   
    2542          ELSE         
     2542            zotx1(:,:) = uu(:,:,1,Kmm) 
     2543            zoty1(:,:) = vv(:,:,1,Kmm) 
     2544         ELSE 
    25432545            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    25442546            CASE( 'oce only'             )      ! C-grid ==> T 
    25452547               DO_2D( 0, 0, 0, 0 ) 
    25462548                  zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) ) 
    2547                   zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji  ,jj-1,1,Kmm) )  
     2549                  zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji  ,jj-1,1,Kmm) ) 
    25482550               END_2D 
    2549             CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T   
     2551            CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T 
    25502552               DO_2D( 0, 0, 0, 0 ) 
    2551                   zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   
     2553                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj) 
    25522554                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 
    25532555                  zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  )     + u_ice(ji-1,jj    )     ) *  fr_i(ji,jj) 
    … …  
    25702572         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
    25712573            !                                                                     ! Ocean component 
    2572             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component  
    2573             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component  
    2574             zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components  
     2574            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
     2575            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
     2576            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
    25752577            zoty1(:,:) = ztmp2(:,:) 
    25762578            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component 
    2577                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component  
    2578                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component  
    2579                zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components  
     2579               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
     2580               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
     2581               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
    25802582               zity1(:,:) = ztmp2(:,:) 
    25812583            ENDIF 
    … …  
    26022604         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid 
    26032605         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid 
    2604          !  
    2605       ENDIF 
    2606       ! 
    2607       !                                                      ! ------------------------- !  
    2608       !                                                      !  Surface current to waves !  
    2609       !                                                      ! ------------------------- !  
    2610       IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN  
    2611           !      
    2612           !                                                  j+1  j     -----V---F  
    2613           ! surface velocity always sent from T point                    !       |  
    2614           !                                                       j      |   T   U  
    2615           !                                                              |       |  
    2616           !                                                   j   j-1   -I-------|  
    2617           !                                               (for I)        |       |  
    2618           !                                                             i-1  i   i  
    2619           !                                                              i      i+1 (for I)  
    2620           SELECT CASE( TRIM( sn_snd_crtw%cldes ) )  
    2621           CASE( 'oce only'             )      ! C-grid ==> T  
     2606         ! 
     2607      ENDIF 
     2608      ! 
     2609      !                                                      ! ------------------------- ! 
     2610      !                                                      !  Surface current to waves ! 
     2611      !                                                      ! ------------------------- ! 
     2612      IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN 
     2613          ! 
     2614          !                                                  j+1  j     -----V---F 
     2615          ! surface velocity always sent from T point                    !       | 
     2616          !                                                       j      |   T   U 
     2617          !                                                              |       | 
     2618          !                                                   j   j-1   -I-------| 
     2619          !                                               (for I)        |       | 
     2620          !                                                             i-1  i   i 
     2621          !                                                              i      i+1 (for I) 
     2622          SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
     2623          CASE( 'oce only'             )      ! C-grid ==> T 
    26222624             DO_2D( 0, 0, 0, 0 ) 
    2623                 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) )  
    2624                 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) )   
     2625                zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) ) 
     2626                zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 
    26252627             END_2D 
    2626           CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T    
     2628          CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T 
    26272629             DO_2D( 0, 0, 0, 0 ) 
    2628                 zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)    
    2629                 zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)  
    2630                 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)  
    2631                 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)  
     2630                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj) 
     2631                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 
     2632                zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     2633                zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
    26322634             END_2D 
    2633              CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp,  zity1, 'T', -1.0_wp )  
    2634           CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T   
     2635             CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp,  zity1, 'T', -1.0_wp ) 
     2636          CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T 
    26352637             DO_2D( 0, 0, 0, 0 ) 
    2636                 zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   &  
    2637                    &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)  
    2638                 zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   &  
    2639                    &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)  
     2638                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   & 
     2639                   &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     2640                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   & 
     2641                   &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
    26402642             END_2D 
    26412643          END SELECT 
    2642          CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp )  
    2643          !  
    2644          !  
    2645          IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components  
    2646          !                                                                        ! Ocean component  
    2647             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 )       ! 1st component   
    2648             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 )       ! 2nd component   
    2649             zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components   
    2650             zoty1(:,:) = ztmp2(:,:)   
    2651             IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component  
    2652                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component   
    2653                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component   
    2654                zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components   
    2655                zity1(:,:) = ztmp2(:,:)  
    2656             ENDIF  
    2657          ENDIF  
    2658          !  
    2659 !         ! spherical coordinates to cartesian -> 2 components to 3 components  
    2660 !         IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN  
    2661 !            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents  
    2662 !            ztmp2(:,:) = zoty1(:,:)  
    2663 !            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )  
    2664 !            !  
    2665 !            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities  
    2666 !               ztmp1(:,:) = zitx1(:,:)  
    2667 !               ztmp1(:,:) = zity1(:,:)  
    2668 !               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )  
    2669 !            ENDIF  
    2670 !         ENDIF  
    2671          !  
    2672          IF( ssnd(jps_ocxw)%laction )   CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid  
    2673          IF( ssnd(jps_ocyw)%laction )   CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid  
    2674          !   
    2675       ENDIF  
    2676       !  
    2677       IF( ssnd(jps_ficet)%laction ) THEN  
    2678          CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info )  
    2679       ENDIF  
    2680       !                                                      ! ------------------------- !  
    2681       !                                                      !   Water levels to waves   !  
    2682       !                                                      ! ------------------------- !  
    2683       IF( ssnd(jps_wlev)%laction ) THEN  
    2684          IF( ln_apr_dyn ) THEN   
    2685             IF( kt /= nit000 ) THEN   
    2686                ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )   
    2687             ELSE   
    2688                ztmp1(:,:) = ssh(:,:,Kbb)   
    2689             ENDIF   
    2690          ELSE   
    2691             ztmp1(:,:) = ssh(:,:,Kmm)   
    2692          ENDIF   
    2693          CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )  
    2694       ENDIF  
     2644         CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 
     2645         ! 
     2646         ! 
     2647         IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
     2648         !                                                                        ! Ocean component 
     2649            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
     2650            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
     2651            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
     2652            zoty1(:,:) = ztmp2(:,:) 
     2653            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component 
     2654               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
     2655               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
     2656               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
     2657               zity1(:,:) = ztmp2(:,:) 
     2658            ENDIF 
     2659         ENDIF 
     2660         ! 
     2661!         ! spherical coordinates to cartesian -> 2 components to 3 components 
     2662!         IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN 
     2663!            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents 
     2664!            ztmp2(:,:) = zoty1(:,:) 
     2665!            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 ) 
     2666!            ! 
     2667!            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities 
     2668!               ztmp1(:,:) = zitx1(:,:) 
     2669!               ztmp1(:,:) = zity1(:,:) 
     2670!               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 ) 
     2671!            ENDIF 
     2672!         ENDIF 
     2673         ! 
     2674         IF( ssnd(jps_ocxw)%laction )   CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
     2675         IF( ssnd(jps_ocyw)%laction )   CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
     2676         ! 
     2677      ENDIF 
     2678      ! 
     2679      IF( ssnd(jps_ficet)%laction ) THEN 
     2680         CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 
     2681      ENDIF 
     2682      !                                                      ! ------------------------- ! 
     2683      !                                                      !   Water levels to waves   ! 
     2684      !                                                      ! ------------------------- ! 
     2685      IF( ssnd(jps_wlev)%laction ) THEN 
     2686         IF( ln_apr_dyn ) THEN 
     2687            IF( kt /= nit000 ) THEN 
     2688               ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     2689            ELSE 
     2690               ztmp1(:,:) = ssh(:,:,Kbb) 
     2691            ENDIF 
     2692         ELSE 
     2693            ztmp1(:,:) = ssh(:,:,Kmm) 
     2694         ENDIF 
     2695         CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     2696      ENDIF 
    26952697      ! 
    26962698      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling 
    … …  
    27092711         CALL cpl_snd( jps_soce  , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info ) 
    27102712      ENDIF 
    2711       !                                                        ! first T level thickness  
     2713      !                                                        ! first T level thickness 
    27122714      IF( ssnd(jps_e3t1st )%laction )  THEN 
    27132715         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm)   , (/jpi,jpj,1/) ), info ) 
    … …  
    27312733#if defined key_si3 
    27322734      !                                                      ! ------------------------- ! 
    2733       !                                                      ! Sea surface freezing temp !  
     2735      !                                                      ! Sea surface freezing temp ! 
    27342736      !                                                      ! ------------------------- ! 
    27352737      ! needed by Met Office 
    … …  
    27402742      ! 
    27412743   END SUBROUTINE sbc_cpl_snd 
    2742     
     2744 
    27432745   !!====================================================================== 
    27442746END MODULE sbccpl 

  • NEMO/trunk/src/OCE/SBC/sbcflx.F90

    r13982 r14072  
    3535   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file 
    3636 !!INTEGER , PARAMETER ::   jp_sfx  = 6   ! index of salt flux flux 
    37    INTEGER , PARAMETER ::   jpfld   = 5 !! 6 ! maximum number of files to read  
     37   INTEGER , PARAMETER ::   jpfld   = 5 !! 6 ! maximum number of files to read 
    3838   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
    3939 
    … …  
    5050      !!--------------------------------------------------------------------- 
    5151      !!                    ***  ROUTINE sbc_flx  *** 
    52       !!                    
     52      !! 
    5353      !! ** Purpose :   provide at each time step the surface ocean fluxes 
    54       !!                (momentum, heat, freshwater and runoff)  
     54      !!                (momentum, heat, freshwater and runoff) 
    5555      !! 
    5656      !! ** Method  : - READ each fluxes in NetCDF files: 
    … …  
    9191      !!--------------------------------------------------------------------- 
    9292      ! 
    93       IF( kt == nit000 ) THEN                ! First call kt=nit000   
     93      IF( kt == nit000 ) THEN                ! First call kt=nit000 
    9494         ! set file information 
    9595         READ  ( numnam_ref, namsbc_flx, IOSTAT = ios, ERR = 901) 
    … …  
    9898         READ  ( numnam_cfg, namsbc_flx, IOSTAT = ios, ERR = 902 ) 
    9999902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist' ) 
    100          IF(lwm) WRITE ( numond, namsbc_flx )  
     100         IF(lwm) WRITE ( numond, namsbc_flx ) 
    101101         ! 
    102102         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 
    103103         IF( ln_dm2dc .AND. sn_qsr%freqh /= 24. )   & 
    104             &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' )  
     104            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
    105105         ! 
    106106         !                                         ! store namelist information in an array 
    107107         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau 
    108          slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr  
     108         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr 
    109109         slf_i(jp_emp ) = sn_emp !! ;   slf_i(jp_sfx ) = sn_sfx 
    110110         ! 
    111111         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
    112          IF( ierror > 0 ) THEN    
    113             CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN   
     112         IF( ierror > 0 ) THEN 
     113            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN 
    114114         ENDIF 
    115115         DO ji= 1, jpfld 
    … …  
    123123 
    124124      CALL fld_read( kt, nn_fsbc, sf )                            ! input fields provided at the current time-step 
    125       
     125 
    126126      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency 
    127127 
    … …  
    138138            qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 
    139139            emp (ji,jj) =   sf(jp_emp )%fnow(ji,jj,1)                              * tmask(ji,jj,1) 
    140             !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1)                              * tmask(ji,jj,1)  
     140            !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1)                              * tmask(ji,jj,1) 
    141141         END_2D 
    142142         !                                                        ! add to qns the heat due to e-p 
    … …  
    144144         !!qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
    145145         ! 
    146          ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x)  
     146         ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x) 
    147147         CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, & 
    148148            &                           qns, 'T',  1._wp, emp , 'T',  1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp  ) 
    149149         ! 
    150150         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked) 
    151             WRITE(numout,*)  
     151            WRITE(numout,*) 
    152152            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK' 
    153153            DO jf = 1, jpfld 
    … …  
    155155               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1 
    156156               IF( jf == jp_emp                     )   zfact = 86400. 
    157                WRITE(numout,*)  
     157               WRITE(numout,*) 
    158158               WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact 
    159159            END DO 
    … …  
    166166      DO_2D( 0, 0, 0, 0 ) 
    167167         ztx = ( utau(ji-1,jj  ) + utau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( umask(ji-1,jj  ,1), umask(ji,jj,1) ) ) 
    168          zty = ( vtau(ji  ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji  ,jj-1,1), vmask(ji,jj,1) ) )  
     168         zty = ( vtau(ji  ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji  ,jj-1,1), vmask(ji,jj,1) ) ) 
    169169         zmod = 0.5_wp * SQRT( ztx * ztx + zty * zty ) * tmask(ji,jj,1) 
    170170         taum(ji,jj) = zmod 

  • NEMO/trunk/src/OCE/SBC/sbcmod.F90

    r14053 r14072  
    1616   !!            4.0  ! 2016-06  (L. Brodeau) new general bulk formulation 
    1717   !!            4.0  ! 2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE) 
    18    !!            4.2  ! 2020-12  (G. Madec, E. Clementi) modified wave forcing and coupling   
     18   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) modified wave forcing and coupling 
    1919   !!---------------------------------------------------------------------- 
    2020 
    … …  
    2828   USE closea         ! closed seas 
    2929   USE phycst         ! physical constants 
     30   USE sbc_phy, ONLY : pp_cldf 
    3031   USE sbc_oce        ! Surface boundary condition: ocean fields 
    3132   USE trc_oce        ! shared ocean-passive tracers variables 
    … …  
    4647   USE sbcssr         ! surface boundary condition: sea surface restoring 
    4748   USE sbcrnf         ! surface boundary condition: runoffs 
    48    USE sbcapr         ! surface boundary condition: atmo pressure  
     49   USE sbcapr         ! surface boundary condition: atmo pressure 
    4950   USE sbcfwb         ! surface boundary condition: freshwater budget 
    5051   USE icbstp         ! Icebergs 
    … …  
    139140         WRITE(numout,*) '         ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl 
    140141         WRITE(numout,*) '         mixed forced-coupled     formulation       ln_mixcpl     = ', ln_mixcpl 
    141 !!gm  lk_oasis is controlled by key_oasis3  ===>>>  It shoud be removed from the namelist  
     142!!gm  lk_oasis is controlled by key_oasis3  ===>>>  It shoud be removed from the namelist 
    142143         WRITE(numout,*) '         OASIS coupling (with atm or sas)           lk_oasis      = ', lk_oasis 
    143144         WRITE(numout,*) '         components of your executable              nn_components = ', nn_components 
    … …  
    162163      !                       !**  check option consistency 
    163164      ! 
    164       IF(lwp) WRITE(numout,*)       !* Single / Multi - executable (NEMO / OPA+SAS)  
     165      IF(lwp) WRITE(numout,*)       !* Single / Multi - executable (NEMO / OPA+SAS) 
    165166      SELECT CASE( nn_components ) 
    166167      CASE( jp_iam_nemo ) 
    … …  
    194195      SELECT CASE( nn_ice ) 
    195196      CASE( 0 )                        !- no ice in the domain 
    196       CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model)   
     197      CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model) 
    197198      CASE( 2 )                        !- SI3  ice model 
    198199         IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) )   & 
    … …  
    202203            &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' ) 
    203204         IF( lk_agrif                                )   & 
    204             &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' )  
     205            &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 
    205206      CASE DEFAULT                     !- not supported 
    206207      END SELECT 
    … …  
    217218      ! 
    218219      IF( sbc_ssr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_ssr arrays' ) 
    219       IF( .NOT.ln_ssr ) THEN               !* Initialize qrp and erp if no restoring  
     220      IF( .NOT.ln_ssr ) THEN               !* Initialize qrp and erp if no restoring 
    220221         qrp(:,:) = 0._wp 
    221222         erp(:,:) = 0._wp 
    … …  
    306307         &   CALL ctl_warn( 'sbc_init : diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
    307308      ! 
    308     
     309 
    309310      !                       !**  associated modules : initialization 
    310311      ! 
    … …  
    378379      ! 
    379380      REAL(wp) ::     zthscl        ! wd  tanh scale 
    380       REAL(wp), DIMENSION(jpi,jpj) ::  zwdht, zwght  ! wd dep over wd limit, wgt   
     381      REAL(wp), DIMENSION(jpi,jpj) ::  zwdht, zwght  ! wd dep over wd limit, wgt 
    381382 
    382383      !!--------------------------------------------------------------------- 
    … …  
    408409      ! 
    409410      !                                            !==  sbc formulation  ==! 
    410       !                                                    
     411      ! 
    411412      ! 
    412413      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    413414      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    414       CASE( jp_usr   )     ;   CALL usrdef_sbc_oce( kt, Kbb )                        ! user defined formulation  
     415      CASE( jp_usr   )     ;   CALL usrdef_sbc_oce( kt, Kbb )                        ! user defined formulation 
    415416      CASE( jp_flx     )   ;   CALL sbc_flx       ( kt )                             ! flux formulation 
    416417      CASE( jp_blk     ) 
    … …  
    476477      IF( ln_icebergs    )   THEN 
    477478                                     CALL icb_stp( kt, Kmm )           ! compute icebergs 
    478          ! Icebergs do not melt over the haloes.  
    479          ! So emp values over the haloes are no more consistent with the inner domain values.  
     479         ! Icebergs do not melt over the haloes. 
     480         ! So emp values over the haloes are no more consistent with the inner domain values. 
    480481         ! A lbc_lnk is therefore needed to ensure reproducibility and restartability. 
    481482         ! see ticket #2113 for discussion about this lbc_lnk. 
    … …  
    491492      ! Special treatment of freshwater fluxes over closed seas in the model domain 
    492493      ! Should not be run if ln_diurnal_only 
    493       IF( l_sbc_clo      )   CALL sbc_clo( kt )    
     494      IF( l_sbc_clo      )   CALL sbc_clo( kt ) 
    494495 
    495496!!$!RBbug do not understand why see ticket 667 
    … …  
    497498!!$      CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp ) 
    498499      IF( ll_wd ) THEN     ! If near WAD point limit the flux for now 
    499          zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999  
     500         zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999 
    500501         zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1   ! do this calc of water 
    501502                                                     ! depth above wd limit once 

  • NEMO/trunk/src/OCE/SBC/sbcrnf.F90

    r14053 r14072  
    3434   PUBLIC   sbc_rnf_alloc ! called in sbcmod module 
    3535   PUBLIC   sbc_rnf_init  ! called in sbcmod module 
    36     
     36 
    3737   !                                                !!* namsbc_rnf namelist * 
    3838   CHARACTER(len=100)         ::   cn_dir            !: Root directory for location of rnf files 
    … …  
    5858   LOGICAL , PUBLIC ::   l_rnfcpl = .false.   !: runoffs recieved from oasis 
    5959   INTEGER , PUBLIC ::   nkrnf = 0            !: nb of levels over which Kz is increased at river mouths 
    60     
     60 
    6161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rnfmsk              !: river mouth mask (hori.) 
    6262   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   rnfmsk_z            !: river mouth mask (vert.) 
    6363   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   h_rnf               !: depth of runoff in m 
    6464   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nk_rnf              !: depth of runoff in model levels 
    65    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s]    
     65   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s] 
    6666 
    6767   TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read) 
    6868   TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_i_rnf     ! structure: iceberg flux (file information, fields read) 
    69    TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)   
    70    TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)   
    71   
     69   TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read) 
     70   TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read) 
     71 
    7272   !! * Substitutions 
    7373#  include "do_loop_substitute.h90" 
    … …  
    247247      INTEGER           ::   ios           ! Local integer output status for namelist read 
    248248      INTEGER           ::   nbrec         ! temporary integer 
    249       REAL(wp)          ::   zacoef   
    250       REAL(wp), DIMENSION(jpi,jpj,2) :: zrnfcl     
     249      REAL(wp)          ::   zacoef 
     250      REAL(wp), DIMENSION(jpi,jpj,2) :: zrnfcl 
    251251      !! 
    252252      NAMELIST/namsbc_rnf/ cn_dir            , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, ln_rnf_icb,   & 
    … …  
    259259      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' ) 
    260260      ! 
    261       IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths  
     261      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths 
    262262         ln_rnf_mouth  = .FALSE.                   ! default definition needed for example by sbc_ssr or by tra_adv_muscl 
    263263         nkrnf         = 0 
    … …  
    295295      !                                   ! ================== 
    296296      ! 
    297       IF( .NOT. l_rnfcpl ) THEN                     
     297      IF( .NOT. l_rnfcpl ) THEN 
    298298         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow) 
    299299         IF(lwp) WRITE(numout,*) 
    … …  
    350350         IF(lwp) WRITE(numout,*) '   ==>>>   runoffs depth read in a file' 
    351351         rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 
    352          IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year  
    353             IF( sn_dep_rnf%clftyp == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month  
     352         IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year 
     353            IF( sn_dep_rnf%clftyp == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month 
    354354         ENDIF 
    355355         CALL iom_open ( rn_dep_file, inum )                             ! open file 

  • NEMO/trunk/src/OCE/SBC/sbcssm.F90

    r13970 r14072  
    1010 
    1111   !!---------------------------------------------------------------------- 
    12    !!   sbc_ssm       : calculate sea surface mean currents, temperature,   
     12   !!   sbc_ssm       : calculate sea surface mean currents, temperature, 
    1313   !!                   and salinity over nn_fsbc time-step 
    1414   !!---------------------------------------------------------------------- 
    … …  
    3131 
    3232   LOGICAL, SAVE ::   l_ssm_mean = .FALSE.   ! keep track of whether means have been read from restart file 
    33     
     33 
    3434#  include "domzgr_substitute.h90" 
    3535   !!---------------------------------------------------------------------- 
    … …  
    4343      !!--------------------------------------------------------------------- 
    4444      !!                     ***  ROUTINE sbc_oce  *** 
    45       !!                      
     45      !! 
    4646      !! ** Purpose :   provide ocean surface variable to sea-surface boundary 
    47       !!                condition computation  
    48       !!                 
    49       !! ** Method  :   compute mean surface velocity (2 components at U and  
     47      !!                condition computation 
     48      !! 
     49      !! ** Method  :   compute mean surface velocity (2 components at U and 
    5050      !!      V-points) [m/s], temperature [Celsius] and salinity [psu] over 
    5151      !!      the periode (kt - nn_fsbc) to kt 
    … …  
    199199         ! 
    200200      ELSE 
    201          !                
     201         ! 
    202202         IF(lwp) WRITE(numout,*) 
    203203         IF(lwp) WRITE(numout,*) 'sbc_ssm_init : sea surface mean fields' 
    … …  
    221221            ! 
    222222            IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN      ! nn_fsbc has changed between 2 runs 
    223                IF(lwp) WRITE(numout,*) '   restart with a change in the frequency of mean from ', zf_sbc, ' to ', nn_fsbc  
    224                zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc  
    225                ssu_m(:,:) = zcoef * ssu_m(:,:)  
     223               IF(lwp) WRITE(numout,*) '   restart with a change in the frequency of mean from ', zf_sbc, ' to ', nn_fsbc 
     224               zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc 
     225               ssu_m(:,:) = zcoef * ssu_m(:,:) 
    226226               ssv_m(:,:) = zcoef * ssv_m(:,:) 
    227227               sst_m(:,:) = zcoef * sst_m(:,:) 
    … …  
    251251      ENDIF 
    252252      ! 
    253       IF( .NOT. ln_traqsr )   fraqsr_1lev(:,:) = 1._wp   ! default definition: qsr 100% in the fisrt level  
     253      IF( .NOT. ln_traqsr )   fraqsr_1lev(:,:) = 1._wp   ! default definition: qsr 100% in the fisrt level 
    254254      ! 
    255255   END SUBROUTINE sbc_ssm_init 

  • NEMO/trunk/src/OCE/SBC/sbcwave.F90

    r14007 r14072  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  sbcwave  *** 
    4    !! Wave module  
     4   !! Wave module 
    55   !!====================================================================== 
    6    !! History :  3.3  !  2011-09  (M. Adani)  Original code: Drag Coefficient  
    7    !!         :  3.4  !  2012-10  (M. Adani)  Stokes Drift  
     6   !! History :  3.3  !  2011-09  (M. Adani)  Original code: Drag Coefficient 
     7   !!         :  3.4  !  2012-10  (M. Adani)  Stokes Drift 
    88   !!            3.6  !  2014-09  (E. Clementi,P. Oddo) New Stokes Drift Computation 
    99   !!             -   !  2016-12  (G. Madec, E. Clementi) update Stoke drift computation 
    1010   !!                                                    + add sbc_wave_ini routine 
    11    !!            4.2  !  2020-12  (G. Madec, E. Clementi) updates, new Stoke drift computation  
     11   !!            4.2  !  2020-12  (G. Madec, E. Clementi) updates, new Stoke drift computation 
    1212   !!                                                    according to Couvelard et al.,2019 
    1313   !!---------------------------------------------------------------------- 
    … …  
    1616   !!   sbc_stokes    : calculate 3D Stokes-drift velocities 
    1717   !!   sbc_wave      : wave data from wave model: forced (netcdf files) or coupled mode 
    18    !!   sbc_wave_init : initialisation fo surface waves  
     18   !!   sbc_wave_init : initialisation fo surface waves 
    1919   !!---------------------------------------------------------------------- 
    2020   USE phycst         ! physical constants 
    … …  
    3636   PUBLIC   sbc_wave        ! routine called in sbcmod 
    3737   PUBLIC   sbc_wave_init   ! routine called in sbcmod 
    38     
     38 
    3939   ! Variables checking if the wave parameters are coupled (if not, they are read from file) 
    4040   LOGICAL, PUBLIC ::   cpl_hsig          = .FALSE. 
    … …  
    113113      INTEGER, INTENT(in) :: Kmm ! ocean time level index 
    114114      INTEGER  ::   jj, ji, jk   ! dummy loop argument 
    115       INTEGER  ::   ik           ! local integer  
     115      INTEGER  ::   ik           ! local integer 
    116116      REAL(wp) ::  ztransp, zfac, ztemp, zsp0, zsqrt, zbreiv16_w 
    117117      REAL(wp) ::  zdep_u, zdep_v, zkh_u, zkh_v, zda_u, zda_v, sdtrp 
    … …  
    143143            IF( cpl_tusd .AND. cpl_tvsd ) THEN  !stokes transport is provided in coupled mode 
    144144               sdtrp      = SQRT( tusd(ji,jj)*tusd(ji,jj) + tvsd(ji,jj)*tvsd(ji,jj) )  !<-- norm of Surface Stokes drift transport 
    145             ELSE  
    146                ! Stokes drift transport estimated from Hs and Tmean  
     145            ELSE 
     146               ! Stokes drift transport estimated from Hs and Tmean 
    147147               sdtrp      = 2.0_wp * rpi / 16.0_wp *                             & 
    148148                   &        hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp ) 
    … …  
    240240      !                       !==  Horizontal divergence of barotropic Stokes transport  ==! 
    241241      div_sd(:,:) = 0._wp 
    242       DO jk = 1, jpkm1                                 !  
     242      DO jk = 1, jpkm1                                 ! 
    243243        div_sd(:,:) = div_sd(:,:) + ze3divh(:,:,jk) 
    244244      END DO 
    … …  
    300300      ENDIF 
    301301 
    302       IF( ln_sdw .AND. .NOT. cpl_sdrftx)  THEN       !==  Computation of the 3d Stokes Drift  ==!  
     302      IF( ln_sdw .AND. .NOT. cpl_sdrftx)  THEN       !==  Computation of the 3d Stokes Drift  ==! 
    303303         ! 
    304304         IF( jpfld > 0 ) THEN                            ! Read from file only if the field is not coupled 
    … …  
    329329      !!              - create the structure used to read required wave fields 
    330330      !!                (its size depends on namelist options) 
    331       !! ** action   
     331      !! ** action 
    332332      !!--------------------------------------------------------------------- 
    333333      INTEGER ::   ierror, ios   ! local integer 
    … …  
    487487               jp_wmp = jpfld 
    488488            ENDIF 
    489             ! 2. Read from file only the non-coupled fields  
     489            ! 2. Read from file only the non-coupled fields 
    490490            IF( jpfld > 0 ) THEN 
    491491               ALLOCATE( slf_i(jpfld) ) 

  • NEMO/trunk/src/OCE/TRA/eosbn2.F90

    r14010 r14072  
    3131   !!   bn2           : compute the Brunt-Vaisala frequency 
    3232   !!   eos_pt_from_ct: compute the potential temperature from the Conservative Temperature 
    33    !!   eos_rab       : generic interface of in situ thermal/haline expansion ratio  
     33   !!   eos_rab       : generic interface of in situ thermal/haline expansion ratio 
    3434   !!   eos_rab_3d    : compute in situ thermal/haline expansion ratio 
    3535   !!   eos_rab_2d    : compute in situ thermal/haline expansion ratio for 2d fields 
    … …  
    4646   USE in_out_manager ! I/O manager 
    4747   USE lib_mpp        ! MPP library 
    48    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     48   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    4949   USE prtctl         ! Print control 
    5050   USE lbclnk         ! ocean lateral boundary conditions 
    … …  
    6363   END INTERFACE 
    6464   ! 
    65    INTERFACE eos_fzp  
     65   INTERFACE eos_fzp 
    6666      MODULE PROCEDURE eos_fzp_2d, eos_fzp_0d 
    6767   END INTERFACE 
    … …  
    8989 
    9090   !                               !!!  simplified eos coefficients (default value: Vallis 2006) 
    91    REAL(wp) ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff.  
    92    REAL(wp) ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff.  
    93    REAL(wp) ::   rn_lambda1 = 5.9520e-2_wp     ! cabbeling coeff. in T^2         
    94    REAL(wp) ::   rn_lambda2 = 5.4914e-4_wp     ! cabbeling coeff. in S^2         
    95    REAL(wp) ::   rn_mu1     = 1.4970e-4_wp     ! thermobaric coeff. in T   
    96    REAL(wp) ::   rn_mu2     = 1.1090e-5_wp     ! thermobaric coeff. in S   
    97    REAL(wp) ::   rn_nu      = 2.4341e-3_wp     ! cabbeling coeff. in theta*salt   
    98     
     91   REAL(wp) ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff. 
     92   REAL(wp) ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff. 
     93   REAL(wp) ::   rn_lambda1 = 5.9520e-2_wp     ! cabbeling coeff. in T^2 
     94   REAL(wp) ::   rn_lambda2 = 5.4914e-4_wp     ! cabbeling coeff. in S^2 
     95   REAL(wp) ::   rn_mu1     = 1.4970e-4_wp     ! thermobaric coeff. in T 
     96   REAL(wp) ::   rn_mu2     = 1.1090e-5_wp     ! thermobaric coeff. in S 
     97   REAL(wp) ::   rn_nu      = 2.4341e-3_wp     ! cabbeling coeff. in theta*salt 
     98 
    9999   ! TEOS10/EOS80 parameters 
    100100   REAL(wp) ::   r1_S0, r1_T0, r1_Z0, rdeltaS 
    101     
     101 
    102102   ! EOS parameters 
    103103   REAL(wp) ::   EOS000 , EOS100 , EOS200 , EOS300 , EOS400 , EOS500 , EOS600 
    … …  
    117117   REAL(wp) ::   EOS022 
    118118   REAL(wp) ::   EOS003 , EOS103 
    119    REAL(wp) ::   EOS013  
    120     
     119   REAL(wp) ::   EOS013 
     120 
    121121   ! ALPHA parameters 
    122122   REAL(wp) ::   ALP000 , ALP100 , ALP200 , ALP300 , ALP400 , ALP500 
    … …  
    133133   REAL(wp) ::   ALP012 
    134134   REAL(wp) ::   ALP003 
    135     
     135 
    136136   ! BETA parameters 
    137137   REAL(wp) ::   BET000 , BET100 , BET200 , BET300 , BET400 , BET500 
    … …  
    160160   REAL(wp) ::   PEN002 , PEN102 
    161161   REAL(wp) ::   PEN012 
    162     
     162 
    163163   ! ALPHA_PEN parameters 
    164164   REAL(wp) ::   APE000 , APE100 , APE200 , APE300 
    … …  
    295295               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
    296296               &  - rn_nu * zt * zs 
    297                !                                  
     297               ! 
    298298            prd(ji,jj,jk) = zn * r1_rho0 * ztm                ! density anomaly (masked) 
    299299         END_3D 
    … …  
    448448            END_3D 
    449449         ENDIF 
    450           
     450 
    451451      CASE( np_seos )                !==  simplified EOS  ==! 
    452452         ! 
    … …  
    997997      !!                  ***  ROUTINE bn2  *** 
    998998      !! 
    999       !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the  
     999      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the 
    10001000      !!                time-step of the input arguments 
    10011001      !! 
    … …  
    10041004      !!      N.B. N^2 is set one for all to zero at jk=1 in istate module. 
    10051005      !! 
    1006       !! ** Action  :   pn2 : square of the brunt-vaisala frequency at w-point  
     1006      !! ** Action  :   pn2 : square of the brunt-vaisala frequency at w-point 
    10071007      !! 
    10081008      !!---------------------------------------------------------------------- 
    … …  
    10211021      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 )      ! interior points only (2=< jk =< jpkm1 ); surface and bottom value set to zero one for all in istate.F90 
    10221022         zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   & 
    1023             &  / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) )  
    1024             ! 
    1025          zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw  
     1023            &  / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 
     1024            ! 
     1025         zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 
    10261026         zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 
    10271027         ! 
    … …  
    11511151         CALL ctl_stop( 'eos_fzp_2d:', ctmp1 ) 
    11521152         ! 
    1153       END SELECT       
     1153      END SELECT 
    11541154      ! 
    11551155  END SUBROUTINE eos_fzp_2d_t 
    … …  
    12081208      !! ** Purpose :   Calculates nonlinear anomalies of alpha_PE, beta_PE and PE at T-points 
    12091209      !! 
    1210       !! ** Method  :   PE is defined analytically as the vertical  
     1210      !! ** Method  :   PE is defined analytically as the vertical 
    12111211      !!                   primitive of EOS times -g integrated between 0 and z>0. 
    12121212      !!                pen is the nonlinear bsq-PE anomaly: pen = ( PE - rho0 gz ) / rho0 gz - rd 
    1213       !!                                                      = 1/z * /int_0^z rd dz - rd  
     1213      !!                                                      = 1/z * /int_0^z rd dz - rd 
    12141214      !!                                where rd is the density anomaly (see eos_rhd function) 
    12151215      !!                ab_pe are partial derivatives of PE anomaly with respect to T and S: 
    … …  
    12751275               ! 
    12761276            zn  = ( zn2 * zh + zn1 ) * zh + zn0 
    1277             !                               
     1277            ! 
    12781278            pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 
    12791279            ! 
    … …  
    12901290               ! 
    12911291            zn  = ( zn2 * zh + zn1 ) * zh + zn0 
    1292             !                               
     1292            ! 
    12931293            pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 
    12941294            ! 
    … …  
    13701370         IF(lwp) WRITE(numout,*) '   ==>>>   use of TEOS-10 equation of state (cons. temp. and abs. salinity)' 
    13711371         ! 
    1372          l_useCT = .TRUE.                          ! model temperature is Conservative temperature  
     1372         l_useCT = .TRUE.                          ! model temperature is Conservative temperature 
    13731373         ! 
    13741374         rdeltaS = 32._wp 
    … …  
    17511751 
    17521752         r1_S0  = 0.875_wp/35.16504_wp   ! Used to convert CT in potential temperature when using bulk formulae (eos_pt_from_ct) 
    1753           
     1753 
    17541754         IF(lwp) THEN 
    17551755            WRITE(numout,*) 
    … …  
    17751775      END SELECT 
    17761776      ! 
    1777       rho0_rcp    = rho0 * rcp  
     1777      rho0_rcp    = rho0 * rcp 
    17781778      r1_rho0     = 1._wp / rho0 
    17791779      r1_rcp      = 1._wp / rcp 
    1780       r1_rho0_rcp = 1._wp / rho0_rcp  
     1780      r1_rho0_rcp = 1._wp / rho0_rcp 
    17811781      ! 
    17821782      IF(lwp) THEN 

  • NEMO/trunk/src/OCE/TRA/traadv.F90

    r13982 r14072  
    22   !!============================================================================== 
    33   !!                       ***  MODULE  traadv  *** 
    4    !! Ocean active tracers:  advection trend  
     4   !! Ocean active tracers:  advection trend 
    55   !!============================================================================== 
    66   !! History :  2.0  !  2005-11  (G. Madec)  Original code 
    77   !!            3.3  !  2010-09  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
    88   !!            3.6  !  2011-06  (G. Madec)  Addition of Mixed Layer Eddy parameterisation 
    9    !!            3.7  !  2014-05  (G. Madec)  Add 2nd/4th order cases for CEN and FCT schemes  
     9   !!            3.7  !  2014-05  (G. Madec)  Add 2nd/4th order cases for CEN and FCT schemes 
    1010   !!             -   !  2014-12  (G. Madec) suppression of cross land advection option 
    1111   !!            3.6  !  2015-06  (E. Clementi) Addition of Stokes drift in case of wave coupling 
    … …  
    3434   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
    3535   USE trd_oce        ! trends: ocean variables 
    36    USE trdtra         ! trends manager: tracers  
    37    USE diaptr         ! Poleward heat transport  
     36   USE trdtra         ! trends manager: tracers 
     37   USE diaptr         ! Poleward heat transport 
    3838   ! 
    3939   USE in_out_manager ! I/O manager 
    … …  
    195195         CASE ( np_MUS )                                 ! MUSCL 
    196196            ! NOTE: [tiling-comms-merge] I added this lbc_lnk as it did not validate against the trunk when using ln_zco 
    197             IF (nn_hls.EQ.2) THEN  
     197            IF (nn_hls.EQ.2) THEN 
    198198                CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    199199#if defined key_loop_fusion 
    200                 CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )  
     200                CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    201201#else 
    202                 CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )  
     202                CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    203203#endif 
    204204            ELSE 
    205                 CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )  
     205                CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    206206            END IF 
    207207         CASE ( np_UBS )                                 ! UBS 
    … …  
    248248      !!--------------------------------------------------------------------- 
    249249      !!                  ***  ROUTINE tra_adv_init  *** 
    250       !!                 
    251       !! ** Purpose :   Control the consistency between namelist options for  
     250      !! 
     251      !! ** Purpose :   Control the consistency between namelist options for 
    252252      !!              tracer advection schemes and set nadv 
    253253      !!---------------------------------------------------------------------- 
    … …  
    290290      ! 
    291291      !                                !==  Parameter control & set nadv ==! 
    292       ioptio = 0                        
     292      ioptio = 0 
    293293      IF( ln_traadv_OFF ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_NO_adv   ;   ENDIF 
    294294      IF( ln_traadv_cen ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_CEN      ;   ENDIF 
    … …  
    319319      ENDIF 
    320320      ! 
    321       !                                !==  Print the choice  ==!   
     321      !                                !==  Print the choice  ==! 
    322322      IF(lwp) THEN 
    323323         WRITE(numout,*) 

  • NEMO/trunk/src/OCE/TRA/traadv_cen.F90

    r13982 r14072  
    1313   USE dom_oce        ! ocean space and time domain 
    1414   USE eosbn2         ! equation of state 
    15    USE traadv_fct     ! acces to routine interp_4th_cpt  
     15   USE traadv_fct     ! acces to routine interp_4th_cpt 
    1616   USE trd_oce        ! trends: ocean variables 
    17    USE trdtra         ! trends manager: tracers  
     17   USE trdtra         ! trends manager: tracers 
    1818   USE diaptr         ! poleward transport diagnostics 
    1919   USE diaar5         ! AR5 diagnostics 
    … …  
    2828 
    2929   PUBLIC   tra_adv_cen   ! called by traadv.F90 
    30     
     30 
    3131   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6 
    3232 
    … …  
    4646 
    4747   SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pU, pV, pW,     & 
    48       &                    Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v )  
     48      &                    Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v ) 
    4949      !!---------------------------------------------------------------------- 
    5050      !!                  ***  ROUTINE tra_adv_cen  *** 
    51       !!                  
     51      !! 
    5252      !! ** Purpose :   Compute the now trend due to the advection of tracers 
    5353      !!      and add it to the general trend of passive tracer equations. 
    5454      !! 
    5555      !! ** Method  :   The advection is evaluated by a 2nd or 4th order scheme 
    56       !!               using now fields (leap-frog scheme).  
     56      !!               using now fields (leap-frog scheme). 
    5757      !!       kn_cen_h = 2  ==>> 2nd order centered scheme on the horizontal 
    5858      !!                = 4  ==>> 4th order    -        -       -      - 
    … …  
    9898      ENDIF 
    9999      ! 
    100       !                     
     100      ! 
    101101      zwz(:,:, 1 ) = 0._wp       ! surface & bottom vertical flux set to zero for all tracers 
    102102      zwz(:,:,jpk) = 0._wp 
    … …  
    155155            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean) 
    156156               DO_2D( 1, 1, 1, 1 ) 
    157                   zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm)  
     157                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm) 
    158158               END_2D 
    159159            ELSE                                   ! no ice-shelf cavities (only ocean surface) 
    … …  
    163163            ENDIF 
    164164         ENDIF 
    165          !                
     165         ! 
    166166         DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !--  Divergence of advective fluxes  --! 
    167167            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs)    & 
    … …  
    185185      ! 
    186186   END SUBROUTINE tra_adv_cen 
    187     
     187 
    188188   !!====================================================================== 
    189189END MODULE traadv_cen 

  • NEMO/trunk/src/OCE/TRA/traadv_fct.F90

    r13982 r14072  
    1010   !!  tra_adv_fct    : update the tracer trend with a 3D advective trends using a 2nd or 4th order FCT scheme 
    1111   !!                   with sub-time-stepping in the vertical direction 
    12    !!  nonosc         : compute monotonic tracer fluxes by a non-oscillatory algorithm  
     12   !!  nonosc         : compute monotonic tracer fluxes by a non-oscillatory algorithm 
    1313   !!  interp_4th_cpt : 4th order compact scheme for the vertical component of the advection 
    1414   !!---------------------------------------------------------------------- 
    … …  
    2424   ! 
    2525   USE in_out_manager ! I/O manager 
    26    USE iom            !  
     26   USE iom            ! 
    2727   USE lib_mpp        ! MPP library 
    28    USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
    29    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     28   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
     29   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3030 
    3131   IMPLICIT NONE 
    … …  
    6060      !!---------------------------------------------------------------------- 
    6161      !!                  ***  ROUTINE tra_adv_fct  *** 
    62       !!  
     62      !! 
    6363      !! **  Purpose :   Compute the now trend due to total advection of tracers 
    6464      !!               and add it to the general trend of tracer equations 
    … …  
    6666      !! **  Method  : - 2nd or 4th FCT scheme on the horizontal direction 
    6767      !!               (choice through the value of kn_fct) 
    68       !!               - on the vertical the 4th order is a compact scheme  
    69       !!               - corrected flux (monotonic correction)  
     68      !!               - on the vertical the 4th order is a compact scheme 
     69      !!               - corrected flux (monotonic correction) 
    7070      !! 
    7171      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends 
    … …  
    154154         ! 
    155155         !        !==  upstream advection with initial mass fluxes & intermediate update  ==! 
    156          !                    !* upstream tracer flux in the i and j direction  
     156         !                    !* upstream tracer flux in the i and j direction 
    157157         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    158158            ! upstream scheme 
    … …  
    173173            IF( ln_isfcav ) THEN                        ! top of the ice-shelf cavities and at the ocean surface 
    174174               DO_2D( 1, 1, 1, 1 ) 
    175                   zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface  
     175                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface 
    176176               END_2D 
    177177            ELSE                                        ! no cavities: only at the ocean surface 
    … …  
    181181            ENDIF 
    182182         ENDIF 
    183          !                
     183         ! 
    184184         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   !* trend and after field with monotonic scheme 
    185185            !                               ! total intermediate advective trends 
    … …  
    193193               &                                  / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 
    194194         END_3D 
    195           
     195 
    196196         IF ( ll_zAimp ) THEN 
    197197            CALL tridia_solver( zwdia, zwsup, zwinf, zwi, zwi , 0 ) 
    … …  
    215215         END IF 
    216216         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    217          IF( l_ptr )   zptry(:,:,:) = zwy(:,:,:)  
     217         IF( l_ptr )   zptry(:,:,:) = zwy(:,:,:) 
    218218         ! 
    219219         !        !==  anti-diffusive flux : high order minus low order  ==! 
    … …  
    268268               zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) ) 
    269269               zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) ) 
    270                !                                                  ! C4 minus upstream advective fluxes  
     270               !                                                  ! C4 minus upstream advective fluxes 
    271271               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk) 
    272272               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
    … …  
    275275            ! 
    276276         END SELECT 
    277          !                       
     277         ! 
    278278         SELECT CASE( kn_fct_v )    !* vertical anti-diffusive fluxes (w-masked interior values) 
    279279         ! 
    … …  
    384384         DEALLOCATE( ztrdx, ztrdy, ztrdz ) 
    385385      ENDIF 
    386       IF( l_ptr ) THEN  
     386      IF( l_ptr ) THEN 
    387387         DEALLOCATE( zptry ) 
    388388      ENDIF 
    … …  
    394394      !!--------------------------------------------------------------------- 
    395395      !!                    ***  ROUTINE nonosc  *** 
    396       !!      
    397       !! **  Purpose :   compute monotonic tracer fluxes from the upstream  
    398       !!       scheme and the before field by a nonoscillatory algorithm  
     396      !! 
     397      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
     398      !!       scheme and the before field by a nonoscillatory algorithm 
    399399      !! 
    400400      !! **  Method  :   ... ??? 
    … …  
    492492      !!---------------------------------------------------------------------- 
    493493      !!                  ***  ROUTINE interp_4th_cpt_org  *** 
    494       !!  
     494      !! 
    495495      !! **  Purpose :   Compute the interpolation of tracer at w-point 
    496496      !! 
    … …  
    503503      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt 
    504504      !!---------------------------------------------------------------------- 
    505        
     505 
    506506      DO_3D( 1, 1, 1, 1, 3, jpkm1 )       !==  build the three diagonal matrix  ==! 
    507507         zwd (ji,jj,jk) = 4._wp 
    … …  
    514514            zwi (ji,jj,jk) = 0._wp 
    515515            zws (ji,jj,jk) = 0._wp 
    516             zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )     
     516            zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) ) 
    517517         ENDIF 
    518518      END_3D 
    … …  
    538538      END_2D 
    539539      DO_3D( 1, 1, 1, 1, 3, jpkm1 ) 
    540          pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)              
     540         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 
    541541      END_3D 
    542542 
    … …  
    547547         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 
    548548      END_3D 
    549       !     
     549      ! 
    550550   END SUBROUTINE interp_4th_cpt_org 
    551     
     551 
    552552 
    553553   SUBROUTINE interp_4th_cpt( pt_in, pt_out ) 
    554554      !!---------------------------------------------------------------------- 
    555555      !!                  ***  ROUTINE interp_4th_cpt  *** 
    556       !!  
     556      !! 
    557557      !! **  Purpose :   Compute the interpolation of tracer at w-point 
    558558      !! 
    … …  
    582582!      CASE( np_CEN2 )   ! 2nd order centered  at top & bottom 
    583583!      END SELECT 
    584 !!gm   
     584!!gm 
    585585      ! 
    586586      IF ( ln_isfcav ) THEN            ! set level two values which may not be set in ISF case 
    … …  
    600600         zwi (ji,jj,ikb) = 0._wp 
    601601         zws (ji,jj,ikb) = 0._wp 
    602          zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,ikb-1) + pt_in(ji,jj,ikb) )             
     602         zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,ikb-1) + pt_in(ji,jj,ikb) ) 
    603603      END_2D 
    604604      ! 
    … …  
    616616      END_2D 
    617617      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 ) 
    618          pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)              
     618         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 
    619619      END_3D 
    620620 
    … …  
    625625         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 
    626626      END_3D 
    627       !     
     627      ! 
    628628   END SUBROUTINE interp_4th_cpt 
    629629 
    … …  
    632632      !!---------------------------------------------------------------------- 
    633633      !!                  ***  ROUTINE tridia_solver  *** 
    634       !!  
     634      !! 
    635635      !! **  Purpose :   solve a symmetric 3diagonal system 
    636636      !! 
    637637      !! **  Method  :   solve M.t_out = RHS(t)  where M is a tri diagonal matrix ( jpk*jpk ) 
    638       !!      
     638      !! 
    639639      !!             ( D_1 U_1  0   0   0  )( t_1 )   ( RHS_1 ) 
    640640      !!             ( L_2 D_2 U_2  0   0  )( t_2 )   ( RHS_2 ) 
    … …  
    642642      !!             (        ...          )( ... )   ( ...  ) 
    643643      !!             (  0   0   0  L_k D_k )( t_k )   ( RHS_k ) 
    644       !!      
     644      !! 
    645645      !!        M is decomposed in the product of an upper and lower triangular matrix. 
    646       !!        The tri-diagonals matrix is given as input 3D arrays:   pD, pU, pL  
     646      !!        The tri-diagonals matrix is given as input 3D arrays:   pD, pU, pL 
    647647      !!        (i.e. the Diagonal, the Upper diagonal, and the Lower diagonal). 
    648648      !!        The solution is pta. 
    … …  
    672672      END_2D 
    673673      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 ) 
    674          pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)              
     674         pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 
    675675      END_3D 
    676676 

  • NEMO/trunk/src/OCE/TRA/traadv_mus.F90

    r13982 r14072  
    2929   USE in_out_manager ! I/O manager 
    3030   USE lib_mpp        ! distribued memory computing 
    31    USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
    32    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     31   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
     32   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3333 
    3434   IMPLICIT NONE 
    … …  
    3636 
    3737   PUBLIC   tra_adv_mus   ! routine called by traadv.F90 
    38     
     38 
    3939   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits 
    4040   !                                                           !  and in closed seas (orca 2 and 1 configurations) 
    4141   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index 
    42     
     42 
    4343   LOGICAL  ::   l_trd   ! flag to compute trends 
    4444   LOGICAL  ::   l_ptr   ! flag to compute poleward transport 
    … …  
    5050   !!---------------------------------------------------------------------- 
    5151   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    52    !! $Id$  
     52   !! $Id$ 
    5353   !! Software governed by the CeCILL license (see ./LICENSE) 
    5454   !!---------------------------------------------------------------------- 
    … …  
    6565      !! 
    6666      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries 
    67       !!              ld_msc_ups=T :  
     67      !!              ld_msc_ups=T : 
    6868      !! 
    6969      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends 
    … …  
    134134         !                                !-- first guess of the slopes 
    135135         zwx(:,:,jpk) = 0._wp                   ! bottom values 
    136          zwy(:,:,jpk) = 0._wp   
     136         zwy(:,:,jpk) = 0._wp 
    137137         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    138138            zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    … …  
    188188            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kbb) ) 
    189189         END IF 
    190          !                                 ! "Poleward" heat and salt transports  
     190         !                                 ! "Poleward" heat and salt transports 
    191191         IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
    192192         !                                 !  heat transport 

  • NEMO/trunk/src/OCE/TRA/traadv_qck.F90

    r13982 r14072  
    1919   USE trc_oce         ! share passive tracers/Ocean variables 
    2020   USE trd_oce         ! trends: ocean variables 
    21    USE trdtra          ! trends manager: tracers  
     21   USE trdtra          ! trends manager: tracers 
    2222   USE diaptr          ! poleward transport diagnostics 
    2323   USE iom 
    … …  
    2626   USE lib_mpp         ! distribued memory computing 
    2727   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    28    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     28   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    2929 
    3030   IMPLICIT NONE 
    … …  
    112112      ! 
    113113      !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 
    114       CALL tra_adv_qck_i( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs )  
    115       CALL tra_adv_qck_j( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs )  
     114      CALL tra_adv_qck_i( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs ) 
     115      CALL tra_adv_qck_j( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs ) 
    116116 
    117117      !        ! vertical fluxes are computed with the 2nd order centered scheme 
    … …  
    142142      DO jn = 1, kjpt                                            ! tracer loop 
    143143         !                                                       ! =========== 
    144          zfu(:,:,:) = 0._wp     ;   zfc(:,:,:) = 0._wp  
    145          zfd(:,:,:) = 0._wp     ;   zwx(:,:,:) = 0._wp    
     144         zfu(:,:,:) = 0._wp     ;   zfc(:,:,:) = 0._wp 
     145         zfd(:,:,:) = 0._wp     ;   zwx(:,:,:) = 0._wp 
    146146         ! 
    147147!!gm why not using a SHIFT instruction... 
    … …  
    151151         END_3D 
    152152         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
    153           
     153 
    154154         ! 
    155155         ! Horizontal advective fluxes 
    156156         ! --------------------------- 
    157157         DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 
    158             zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    159             zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T  
     158            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
     159            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T 
    160160         END_3D 
    161161         ! 
    162162         DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 
    163             zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     163            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
    164164            zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    165165            zwx(ji,jj,jk)  = ABS( pU(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
    … …  
    167167            zfd(ji,jj,jk)  = zdir * pt(ji+1,jj,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji  ,jj,jk,jn,Kbb)  ! FD in the x-direction for T 
    168168         END_3D 
    169          !--- Lateral boundary conditions  
     169         !--- Lateral boundary conditions 
    170170         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp ) 
    171171 
    … …  
    227227      DO jn = 1, kjpt                                            ! tracer loop 
    228228         !                                                       ! =========== 
    229          zfu(:,:,:) = 0.0     ;   zfc(:,:,:) = 0.0   
    230          zfd(:,:,:) = 0.0     ;   zwy(:,:,:) = 0.0      
    231          !                                                   
    232          DO jk = 1, jpkm1                                 
    233             !                                              
     229         zfu(:,:,:) = 0.0     ;   zfc(:,:,:) = 0.0 
     230         zfd(:,:,:) = 0.0     ;   zwy(:,:,:) = 0.0 
     231         ! 
     232         DO jk = 1, jpkm1 
     233            ! 
    234234            !--- Computation of the ustream and downstream value of the tracer and the mask 
    235235            DO_2D( nn_hls-1, nn_hls-1, 0, 0 ) 
    … …  
    241241         END DO 
    242242         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
    243           
     243 
    244244         ! 
    245245         ! Horizontal advective fluxes 
    … …  
    247247         ! 
    248248         DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 
    249             zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    250             zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T  
     249            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
     250            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T 
    251251         END_3D 
    252252         ! 
    253253         DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 
    254             zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     254            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
    255255            zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    256256            zwy(ji,jj,jk)  = ABS( pV(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
    … …  
    259259         END_3D 
    260260 
    261          !--- Lateral boundary conditions  
     261         !--- Lateral boundary conditions 
    262262         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 
    263263 
    … …  
    328328            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean) 
    329329               DO_2D( 0, 0, 0, 0 ) 
    330                   zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm)   ! linear free surface  
     330                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm)   ! linear free surface 
    331331               END_2D 
    332332            ELSE                                   ! no ocean cavities (only ocean surface) 
    … …  
    354354      !! ** Purpose :  Computation of advective flux with Quickest scheme 
    355355      !! 
    356       !! ** Method :    
     356      !! ** Method : 
    357357      !!---------------------------------------------------------------------- 
    358358      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   pfu   ! second upwind point 
    … …  
    361361      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   puc   ! input as Courant number ; output as flux 
    362362      !! 
    363       INTEGER  ::  ji, jj, jk               ! dummy loop indices  
    364       REAL(wp) ::  zcoef1, zcoef2, zcoef3   ! local scalars           
     363      INTEGER  ::  ji, jj, jk               ! dummy loop indices 
     364      REAL(wp) ::  zcoef1, zcoef2, zcoef3   ! local scalars 
    365365      REAL(wp) ::  zc, zcurv, zfho          !   -      - 
    366366      !---------------------------------------------------------------------- 
    … …  
    372372         zcoef2 = 0.5 * zc * ( pfd(ji,jj,jk) - pfc(ji,jj,jk) ) 
    373373         zcoef3 = ( 1. - ( zc * zc ) ) * r1_6 * zcurv 
    374          zfho   = zcoef1 - zcoef2 - zcoef3              !  phi_f QUICKEST  
     374         zfho   = zcoef1 - zcoef2 - zcoef3              !  phi_f QUICKEST 
    375375         ! 
    376376         zcoef1 = pfd(ji,jj,jk) - pfu(ji,jj,jk) 
    … …  
    378378         zcoef3 = ABS( zcurv ) 
    379379         IF( zcoef3 >= zcoef2 ) THEN 
    380             zfho = pfc(ji,jj,jk)  
     380            zfho = pfc(ji,jj,jk) 
    381381         ELSE 
    382382            zcoef3 = pfu(ji,jj,jk) + ( ( pfc(ji,jj,jk) - pfu(ji,jj,jk) ) / MAX( zc, 1.e-9 ) )    ! phi_REF 
    383383            IF( zcoef1 >= 0. ) THEN 
    384                zfho = MAX( pfc(ji,jj,jk), zfho )  
    385                zfho = MIN( zfho, MIN( zcoef3, pfd(ji,jj,jk) ) )  
     384               zfho = MAX( pfc(ji,jj,jk), zfho ) 
     385               zfho = MIN( zfho, MIN( zcoef3, pfd(ji,jj,jk) ) ) 
    386386            ELSE 
    387                zfho = MIN( pfc(ji,jj,jk), zfho )  
    388                zfho = MAX( zfho, MAX( zcoef3, pfd(ji,jj,jk) ) )  
     387               zfho = MIN( pfc(ji,jj,jk), zfho ) 
     388               zfho = MAX( zfho, MAX( zcoef3, pfd(ji,jj,jk) ) ) 
    389389            ENDIF 
    390390         ENDIF 

  • NEMO/trunk/src/OCE/TRA/traadv_ubs.F90

    r13982 r14072  
    1010   !!---------------------------------------------------------------------- 
    1111   !!   tra_adv_ubs : update the tracer trend with the horizontal 
    12    !!                 advection trends using a third order biaised scheme   
     12   !!                 advection trends using a third order biaised scheme 
    1313   !!---------------------------------------------------------------------- 
    1414   USE oce            ! ocean dynamics and active tracers 
    … …  
    1616   USE trc_oce        ! share passive tracers/Ocean variables 
    1717   USE trd_oce        ! trends: ocean variables 
    18    USE traadv_fct      ! acces to routine interp_4th_cpt  
    19    USE trdtra         ! trends manager: tracers  
     18   USE traadv_fct      ! acces to routine interp_4th_cpt 
     19   USE trdtra         ! trends manager: tracers 
    2020   USE diaptr         ! poleward transport diagnostics 
    2121   USE diaar5         ! AR5 diagnostics 
    … …  
    2525   USE lib_mpp        ! massively parallel library 
    2626   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    27    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     27   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    2828 
    2929   IMPLICIT NONE 
    … …  
    5151      !!---------------------------------------------------------------------- 
    5252      !!                  ***  ROUTINE tra_adv_ubs  *** 
    53       !!                  
     53      !! 
    5454      !! ** Purpose :   Compute the now trend due to the advection of tracers 
    5555      !!      and add it to the general trend of passive tracer equations. 
    … …  
    6060      !!      For example the i-component of the advective fluxes are given by : 
    6161      !!                !  e2u e3u un ( mi(Tn) - zltu(i  ) )   if un(i) >= 0 
    62       !!          ztu = !  or  
     62      !!          ztu = !  or 
    6363      !!                !  e2u e3u un ( mi(Tn) - zltu(i+1) )   if un(i) < 0 
    6464      !!      where zltu is the second derivative of the before temperature field: 
    6565      !!          zltu = 1/e3t di[ e2u e3u / e1u di[Tb] ] 
    66       !!        This results in a dissipatively dominant (i.e. hyper-diffusive)  
    67       !!      truncation error. The overall performance of the advection scheme  
    68       !!      is similar to that reported in (Farrow and Stevens, 1995).  
     66      !!        This results in a dissipatively dominant (i.e. hyper-diffusive) 
     67      !!      truncation error. The overall performance of the advection scheme 
     68      !!      is similar to that reported in (Farrow and Stevens, 1995). 
    6969      !!        For stability reasons, the first term of the fluxes which corresponds 
    70       !!      to a second order centered scheme is evaluated using the now velocity  
    71       !!      (centered in time) while the second term which is the diffusive part  
    72       !!      of the scheme, is evaluated using the before velocity (forward in time).  
     70      !!      to a second order centered scheme is evaluated using the now velocity 
     71      !!      (centered in time) while the second term which is the diffusive part 
     72      !!      of the scheme, is evaluated using the before velocity (forward in time). 
    7373      !!      Note that UBS is not positive. Do not use it on passive tracers. 
    7474      !!                On the vertical, the advection is evaluated using a FCT scheme, 
    75       !!      as the UBS have been found to be too diffusive.  
    76       !!                kn_ubs_v argument controles whether the FCT is based on  
    77       !!      a 2nd order centrered scheme (kn_ubs_v=2) or on a 4th order compact  
     75      !!      as the UBS have been found to be too diffusive. 
     76      !!                kn_ubs_v argument controles whether the FCT is based on 
     77      !!      a 2nd order centrered scheme (kn_ubs_v=2) or on a 4th order compact 
    7878      !!      scheme (kn_ubs_v=4). 
    7979      !! 
    … …  
    8282      !!             - poleward advective heat and salt transport (ln_diaptr=T) 
    8383      !! 
    84       !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404.  
     84      !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404. 
    8585      !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731�1741. 
    8686      !!---------------------------------------------------------------------- 
    … …  
    125125      DO jn = 1, kjpt                                            ! tracer loop 
    126126         !                                                       ! =========== 
    127          !                                               
     127         ! 
    128128         DO jk = 1, jpkm1                !==  horizontal laplacian of before tracer ==! 
    129129            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                   ! First derivative (masked gradient) 
    … …  
    138138               zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef 
    139139            END_2D 
    140             !                                     
    141          END DO          
     140            ! 
     141         END DO 
    142142         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    143          !     
     143         ! 
    144144         DO_3D( 1, 0, 1, 0, 1, jpkm1 )   !==  Horizontal advective fluxes  ==!     (UBS) 
    145145            zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) )        ! upstream transport (x2) 
    … …  
    166166                  &                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    167167            END_2D 
    168             !                                              
     168            ! 
    169169         END DO 
    170170         ! 
    … …  
    177177             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztv, pV, pt(:,:,:,jn,Kmm) ) 
    178178         END IF 
    179          !      
     179         ! 
    180180         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    181181         IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', ztv(:,:,:) ) 
    … …  
    188188         SELECT CASE( kn_ubs_v )       ! select the vertical advection scheme 
    189189         ! 
    190          CASE(  2  )                   ! 2nd order FCT  
    191             !          
     190         CASE(  2  )                   ! 2nd order FCT 
     191            ! 
    192192            IF( l_trd ) THEN 
    193193               DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    … …  
    205205               IF( ln_isfcav ) THEN                   ! top of the ice-shelf cavities and at the ocean surface 
    206206                  DO_2D( 1, 1, 1, 1 ) 
    207                      ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface  
     207                     ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface 
    208208                  END_2D 
    209209               ELSE                                   ! no cavities: only at the ocean surface 
    … …  
    217217               ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )    & 
    218218                  &     * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    219                pt(ji,jj,jk,jn,Krhs) =   pt(ji,jj,jk,jn,Krhs) +  ztak  
     219               pt(ji,jj,jk,jn,Krhs) =   pt(ji,jj,jk,jn,Krhs) +  ztak 
    220220               zti(ji,jj,jk)    = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
    221221            END_3D 
    … …  
    266266      !!--------------------------------------------------------------------- 
    267267      !!                    ***  ROUTINE nonosc_z  *** 
    268       !!      
    269       !! **  Purpose :   compute monotonic tracer fluxes from the upstream  
    270       !!       scheme and the before field by a nonoscillatory algorithm  
     268      !! 
     269      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
     270      !!       scheme and the before field by a nonoscillatory algorithm 
    271271      !! 
    272272      !! **  Method  :   ... ??? 

  • NEMO/trunk/src/OCE/TRA/traatf.F90

    r14045 r14072  
    2626   !!---------------------------------------------------------------------- 
    2727   USE oce             ! ocean dynamics and tracers variables 
    28    USE dom_oce         ! ocean space and time domain variables  
     28   USE dom_oce         ! ocean space and time domain variables 
    2929   USE sbc_oce         ! surface boundary condition: ocean 
    3030   USE sbcrnf          ! river runoffs 
    … …  
    3333   USE domvvl          ! variable volume 
    3434   USE trd_oce         ! trends: ocean variables 
    35    USE trdtra          ! trends manager: tracers  
     35   USE trdtra          ! trends manager: tracers 
    3636   USE traqsr          ! penetrative solar radiation (needed for nksr) 
    3737   USE phycst          ! physical constant 
    … …  
    7070      !!                   ***  ROUTINE traatf  *** 
    7171      !! 
    72       !! ** Purpose :   Apply the boundary condition on the after temperature   
     72      !! ** Purpose :   Apply the boundary condition on the after temperature 
    7373      !!             and salinity fields and add the Asselin time filter on now fields. 
    74       !!  
    75       !! ** Method  :   At this stage of the computation, ta and sa are the  
     74      !! 
     75      !! ** Method  :   At this stage of the computation, ta and sa are the 
    7676      !!             after temperature and salinity as the time stepping has 
    7777      !!             been performed in trazdf_imp or trazdf_exp module. 
    7878      !! 
    79       !!              - Apply lateral boundary conditions on (ta,sa)  
    80       !!             at the local domain   boundaries through lbc_lnk call,  
    81       !!             at the one-way open boundaries (ln_bdy=T),  
     79      !!              - Apply lateral boundary conditions on (ta,sa) 
     80      !!             at the local domain   boundaries through lbc_lnk call, 
     81      !!             at the one-way open boundaries (ln_bdy=T), 
    8282      !!             at the AGRIF zoom   boundaries (lk_agrif=T) 
    8383      !! 
    … …  
    8989      INTEGER                                  , INTENT(in   ) :: kt             ! ocean time-step index 
    9090      INTEGER                                  , INTENT(in   ) :: Kbb, Kmm, Kaa  ! time level indices 
    91       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers  
     91      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers 
    9292      !! 
    9393      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    105105 
    106106      ! Update after tracer on domain lateral boundaries 
    107       !  
     107      ! 
    108108#if defined key_agrif 
    109109      CALL Agrif_tra                     ! AGRIF zoom boundaries 
    … …  
    113113      ! 
    114114      IF( ln_bdy )   CALL bdy_tra( kt, Kbb, pts, Kaa )  ! BDY open boundaries 
    115   
     115 
    116116      ! trends computation initialisation 
    117       IF( l_trdtra )   THEN                     
     117      IF( l_trdtra )   THEN 
    118118         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    119119         ztrdt(:,:,:) = 0._wp 
    120120         ztrds(:,:,:) = 0._wp 
    121          IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend  
     121         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend 
    122122            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 
    123123            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_zdfp, ztrds ) 
    124124         ENDIF 
    125          ! total trend for the non-time-filtered variables.  
     125         ! total trend for the non-time-filtered variables. 
    126126         zfact = 1.0 / rn_Dt 
    127127         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from pts(Kmm) terms 
    … …  
    133133         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_tot, ztrds ) 
    134134         IF( ln_linssh ) THEN       ! linear sea surface height only 
    135             ! Store now fields before applying the Asselin filter  
     135            ! Store now fields before applying the Asselin filter 
    136136            ! in order to calculate Asselin filter trend later. 
    137             ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kmm)  
     137            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kmm) 
    138138            ztrds(:,:,:) = pts(:,:,:,jp_sal,Kmm) 
    139139         ENDIF 
    140140      ENDIF 
    141141 
    142       IF( l_1st_euler ) THEN       ! Euler time-stepping  
     142      IF( l_1st_euler ) THEN       ! Euler time-stepping 
    143143         ! 
    144144         IF (l_trdtra .AND. .NOT. ln_linssh ) THEN   ! Zero Asselin filter contribution must be explicitly written out since for vvl 
    … …  
    152152      ELSE                                            ! Leap-Frog + Asselin filter time stepping 
    153153         ! 
    154          IF( ln_linssh ) THEN   ;   CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nit000,        'TRA', pts, jpts )  ! linear free surface  
     154         IF( ln_linssh ) THEN   ;   CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nit000,        'TRA', pts, jpts )  ! linear free surface 
    155155         ELSE                   ;   CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nit000, rn_Dt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface 
    156156         ENDIF 
    157157         ! 
    158          CALL lbc_lnk_multi( 'traatf',  pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp )  
    159  
    160       ENDIF      
    161       ! 
    162       IF( l_trdtra .AND. ln_linssh ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
     158         CALL lbc_lnk_multi( 'traatf',  pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 
     159 
     160      ENDIF 
     161      ! 
     162      IF( l_trdtra .AND. ln_linssh ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt 
    163163         DO jk = 1, jpkm1 
    164164            ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kmm) - ztrdt(:,:,jk) ) * r1_Dt 
    … …  
    184184      !! 
    185185      !! ** Purpose :   fixed volume: apply the Asselin time filter to the "now" field 
    186       !!  
     186      !! 
    187187      !! ** Method  : - Apply a Asselin time filter on now fields. 
    188188      !! 
    … …  
    209209         ! 
    210210         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    211             ztn = pt(ji,jj,jk,jn,Kmm)                                     
     211            ztn = pt(ji,jj,jk,jn,Kmm) 
    212212            ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb)  ! time laplacian on tracers 
    213213            ! 
    … …  
    224224      !!                   ***  ROUTINE tra_atf_vvl  *** 
    225225      !! 
    226       !! ** Purpose :   Time varying volume: apply the Asselin time filter   
    227       !!  
     226      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
     227      !! 
    228228      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields. 
    229229      !!             pt(Kmm)  = ( e3t_Kmm*pt(Kmm) + rn_atfp*[ e3t_Kbb*pt(Kbb) - 2 e3t_Kmm*pt(Kmm) + e3t_Kaa*pt(Kaa) ] ) 
    … …  
    255255      ENDIF 
    256256      ! 
    257       IF( cdtype == 'TRA' )  THEN    
     257      IF( cdtype == 'TRA' )  THEN 
    258258         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration 
    259259         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs 
    … …  
    261261      ELSE                          ! passive tracers case 
    262262         ll_traqsr  = .FALSE.          ! NO solar penetration 
    263          ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ?   
    264          ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ??  
     263         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ? 
     264         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ?? 
    265265      ENDIF 
    266266      ! 
    … …  
    272272      zfact1 = rn_atfp * p2dt 
    273273      zfact2 = zfact1 * r1_rho0 
    274       DO jn = 1, kjpt       
     274      DO jn = 1, kjpt 
    275275         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    276276            ze3t_b = e3t(ji,jj,jk,Kbb) 
    … …  
    289289            ! 
    290290            ! Add asselin correction on scale factors: 
    291             zscale = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) )  
    292             ze3t_f = ze3t_f - zfact2 * zscale * ( emp_b(ji,jj) - emp(ji,jj) )  
    293             IF ( ll_rnf ) ze3t_f = ze3t_f + zfact2 * zscale * (    rnf_b(ji,jj) -    rnf(ji,jj) )  
     291            zscale = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 
     292            ze3t_f = ze3t_f - zfact2 * zscale * ( emp_b(ji,jj) - emp(ji,jj) ) 
     293            IF ( ll_rnf ) ze3t_f = ze3t_f + zfact2 * zscale * (    rnf_b(ji,jj) -    rnf(ji,jj) ) 
    294294            IF ( ll_isf ) THEN 
    295295               IF ( ln_isfcav_mlt ) ze3t_f = ze3t_f - zfact2 * zscale * ( fwfisf_cav_b(ji,jj) - fwfisf_cav(ji,jj) ) 
    … …  
    297297            ENDIF 
    298298            ! 
    299             IF( jk == mikt(ji,jj) ) THEN           ! first level  
     299            IF( jk == mikt(ji,jj) ) THEN           ! first level 
    300300               ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) ) 
    301301            ENDIF 
    302302            ! 
    303303            ! solar penetration (temperature only) 
    304             IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            &  
    305                &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )  
     304            IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
     305               &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
    306306               ! 
    307307            ! 
    308308            IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          & 
    309                &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &  
     309               &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
    310310               &                              * e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj) 
    311311 
    … …  
    321321                        &                     * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) 
    322322                  END IF 
    323                   ! level partially include in Losch_2008 ice shelf boundary layer  
     323                  ! level partially include in Losch_2008 ice shelf boundary layer 
    324324                  IF ( jk == misfkb_cav(ji,jj) ) THEN 
    325325                     ztc_f  = ztc_f  - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) )  & 
    … …  
    335335                            &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) 
    336336                  END IF 
    337                   ! level partially include in Losch_2008 ice shelf boundary layer  
     337                  ! level partially include in Losch_2008 ice shelf boundary layer 
    338338                  IF ( jk == misfkb_par(ji,jj) ) THEN 
    339339                     ztc_f  = ztc_f  - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) )  & 
    … …  
    364364            ! 
    365365         END_3D 
    366          !  
     366         ! 
    367367      END DO 
    368368      ! 
    369369      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN 
    370          IF( l_trdtra .AND. cdtype == 'TRA' ) THEN  
     370         IF( l_trdtra .AND. cdtype == 'TRA' ) THEN 
    371371            CALL trd_tra( kt, Kmm, Kaa, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) ) 
    372372            CALL trd_tra( kt, Kmm, Kaa, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) ) 

  • NEMO/trunk/src/OCE/TRA/traatf_qco.F90

    r14053 r14072  
    100100         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    101101      ENDIF 
    102 !!st  Update after tracer on domain lateral boundaries as been removed outside  
     102!!st  Update after tracer on domain lateral boundaries as been removed outside 
    103103 
    104104      ! trends computation initialisation 

  • NEMO/trunk/src/OCE/TRA/trabbc.F90

    r13982 r14072  
    1212 
    1313   !!---------------------------------------------------------------------- 
    14    !!   tra_bbc       : update the tracer trend at ocean bottom  
     14   !!   tra_bbc       : update the tracer trend at ocean bottom 
    1515   !!   tra_bbc_init  : initialization of geothermal heat flux trend 
    1616   !!---------------------------------------------------------------------- 
    … …  
    1919   USE phycst         ! physical constants 
    2020   USE trd_oce        ! trends: ocean variables 
    21    USE trdtra         ! trends manager: tracers  
     21   USE trdtra         ! trends manager: tracers 
    2222   ! 
    2323   USE in_out_manager ! I/O manager 
    24    USE iom            ! xIOS  
     24   USE iom            ! xIOS 
    2525   USE fldread        ! read input fields 
    2626   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    … …  
    4343 
    4444   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh   ! structure of input qgh (file informations, fields read) 
    45   
     45 
    4646   !! * Substitutions 
    4747#  include "do_loop_substitute.h90" 
    … …  
    5858      !!                  ***  ROUTINE tra_bbc  *** 
    5959      !! 
    60       !! ** Purpose :   Compute the bottom boundary contition on temperature  
    61       !!              associated with geothermal heating and add it to the  
     60      !! ** Purpose :   Compute the bottom boundary contition on temperature 
     61      !!              associated with geothermal heating and add it to the 
    6262      !!              general trend of temperature equations. 
    6363      !! 
    64       !! ** Method  :   The geothermal heat flux set to its constant value of  
     64      !! ** Method  :   The geothermal heat flux set to its constant value of 
    6565      !!              86.4 mW/m2 (Stein and Stein 1992, Huang 1999). 
    6666      !!       The temperature trend associated to this heat flux through the 
    … …  
    135135      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files 
    136136      !! 
    137       NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir  
     137      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
    138138      !!---------------------------------------------------------------------- 
    139139      ! 

  • NEMO/trunk/src/OCE/TRA/trabbl.F90

    r13982 r14072  
    3131   USE trdtra         ! trends: active tracers 
    3232   ! 
    33    USE iom            ! IOM library                
     33   USE iom            ! IOM library 
    3434   USE in_out_manager ! I/O manager 
    3535   USE lbclnk         ! ocean lateral boundary conditions 
    3636   USE prtctl         ! Print control 
    3737   USE timing         ! Timing 
    38    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     38   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3939 
    4040   IMPLICIT NONE 
    … …  
    200200            zptb(ji,jj) = pt(ji,jj,ik,jn)                ! bottom before T and S 
    201201         END_2D 
    202          !                
     202         ! 
    203203         DO_2D( 0, 0, 0, 0 )                               ! Compute the trend 
    204204            ik = mbkt(ji,jj)                            ! bottom T-level index 
    … …  
    399399               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point 
    400400               zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
    401                !                                                          ! 2*masked bottom density gradient  
     401               !                                                          ! 2*masked bottom density gradient 
    402402               zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    & 
    403403                         - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
    … …  
    523523      END_2D 
    524524      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    525       zmbku(:,:) = REAL( mbku_d(:,:), wp )   ;     zmbkv(:,:) = REAL( mbkv_d(:,:), wp )   
    526       CALL lbc_lnk_multi( 'trabbl', zmbku,'U',1.0_wp, zmbkv,'V',1.0_wp)  
     525      zmbku(:,:) = REAL( mbku_d(:,:), wp )   ;     zmbkv(:,:) = REAL( mbkv_d(:,:), wp ) 
     526      CALL lbc_lnk_multi( 'trabbl', zmbku,'U',1.0_wp, zmbkv,'V',1.0_wp) 
    527527      mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ;  mbkv_d(:,:) = MAX( NINT( zmbkv(:,:) ), 1 ) 
    528528      ! 

  • NEMO/trunk/src/OCE/TRA/tradmp.F90

    r13982 r14072  
    1111   !!  NEMO      1.0  ! 2002-08  (G. Madec, E. Durand)  free form + modules 
    1212   !!            3.2  ! 2009-08  (G. Madec, C. Talandier)  DOCTOR norm for namelist parameter 
    13    !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC  
     13   !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC 
    1414   !!            3.4  ! 2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys 
    1515   !!            3.6  ! 2015-06  (T. Graham)  read restoring coefficient in a file 
    … …  
    2626   USE c1d            ! 1D vertical configuration 
    2727   USE trd_oce        ! trends: ocean variables 
    28    USE trdtra         ! trends manager: tracers  
     28   USE trdtra         ! trends manager: tracers 
    2929   USE zdf_oce        ! ocean: vertical physics 
    3030   USE phycst         ! physical constants 
    … …  
    5555   !!---------------------------------------------------------------------- 
    5656   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    57    !! $Id$  
     57   !! $Id$ 
    5858   !! Software governed by the CeCILL license (see ./LICENSE) 
    5959   !!---------------------------------------------------------------------- 
    … …  
    7575      !!---------------------------------------------------------------------- 
    7676      !!                   ***  ROUTINE tra_dmp  *** 
    77       !!                   
     77      !! 
    7878      !! ** Purpose :   Compute the tracer trend due to a newtonian damping 
    7979      !!      of the tracer field towards given data field and add it to the 
    8080      !!      general tracer trends. 
    8181      !! 
    82       !! ** Method  :   Newtonian damping towards t_dta and s_dta computed  
     82      !! ** Method  :   Newtonian damping towards t_dta and s_dta computed 
    8383      !!      and add to the general tracer trends: 
    8484      !!                     ta = ta + resto * (t_dta - tb) 
    … …  
    158158      !!---------------------------------------------------------------------- 
    159159      !!                  ***  ROUTINE tra_dmp_init  *** 
    160       !!  
    161       !! ** Purpose :   Initialization for the newtonian damping  
     160      !! 
     161      !! ** Purpose :   Initialization for the newtonian damping 
    162162      !! 
    163163      !! ** Method  :   read the namtra_dmp namelist and check the parameters 
    164164      !!---------------------------------------------------------------------- 
    165       INTEGER ::   ios, imask   ! local integers  
     165      INTEGER ::   ios, imask   ! local integers 
    166166      ! 
    167167      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto 

  • NEMO/trunk/src/OCE/TRA/traisf.F90

    r13982 r14072  
    3535      !!---------------------------------------------------------------------- 
    3636      !!                  ***  ROUTINE tra_isf  *** 
    37       !!                    
     37      !! 
    3838      !! ** Purpose :  Compute the temperature trend due to the ice shelf melting (qhoce + qhc) 
    3939      !! 
    … …  
    6565         ! 
    6666         ! Dynamical stability at start up after change in under ice shelf cavity geometry is achieve by correcting the divergence. 
    67          ! This is achieved by applying a volume flux in order to keep the horizontal divergence after remapping  
     67         ! This is achieved by applying a volume flux in order to keep the horizontal divergence after remapping 
    6868         ! the same as at the end of the latest time step. So correction need to be apply at nit000 (euler time step) and 
    6969         ! half of it at nit000+1 (leap frog time step). 
    … …  
    9595      !! *** Purpose :  Compute the temperature trend due to the ice shelf melting (qhoce + qhc) for cav or par case 
    9696      !! 
    97       !! *** Action :: Update pts(:,:,:,:,Krhs) with the surface boundary condition trend  
     97      !! *** Action :: Update pts(:,:,:,:,Krhs) with the surface boundary condition trend 
    9898      !! 
    9999      !!---------------------------------------------------------------------- 
    … …  
    104104      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) :: ptsc , ptsc_b 
    105105      !!---------------------------------------------------------------------- 
    106       INTEGER                      :: ji,jj,jk  ! loop index    
     106      INTEGER                      :: ji,jj,jk  ! loop index 
    107107      INTEGER                      :: ikt, ikb  ! top and bottom level of the tbl 
    108108      REAL(wp), DIMENSION(A2D(nn_hls))     :: ztc       ! total ice shelf tracer trend 
    … …  
    125125         END DO 
    126126         ! 
    127          ! level partially include in ice shelf boundary layer  
     127         ! level partially include in ice shelf boundary layer 
    128128         pts(ji,jj,ikb,jp_tem) = pts(ji,jj,ikb,jp_tem) + ztc(ji,jj) * pfrac(ji,jj) 
    129129         ! 
    … …  
    136136      !!                  ***  ROUTINE tra_isf_cpl  *** 
    137137      !! 
    138       !! *** Action :: Update pts(:,:,:,:,Krhs) with the ice shelf coupling trend  
     138      !! *** Action :: Update pts(:,:,:,:,Krhs) with the ice shelf coupling trend 
    139139      !! 
    140140      !!---------------------------------------------------------------------- 

  • NEMO/trunk/src/OCE/TRA/traldf.F90

    r13982 r14072  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  traldf  *** 
    4    !! Ocean Active tracers : lateral diffusive trends  
     4   !! Ocean Active tracers : lateral diffusive trends 
    55   !!===================================================================== 
    66   !! History :  9.0  ! 2005-11  (G. Madec)  Original code 
    7    !!  NEMO      3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA  
     7   !!  NEMO      3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
    88   !!            3.7  ! 2013-12  (G. Madec) remove the optional computation from T & S anomaly profiles and traldf_bilapg 
    99   !!             -   ! 2013-12  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction 
    … …  
    3737   PRIVATE 
    3838 
    39    PUBLIC   tra_ldf        ! called by step.F90  
    40    PUBLIC   tra_ldf_init   ! called by nemogcm.F90  
     39   PUBLIC   tra_ldf        ! called by step.F90 
     40   PUBLIC   tra_ldf_init   ! called by nemogcm.F90 
    4141 
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    44    !! $Id$  
     44   !! $Id$ 
    4545   !! Software governed by the CeCILL license (see ./LICENSE) 
    4646   !!---------------------------------------------------------------------- 
    … …  
    5050      !!---------------------------------------------------------------------- 
    5151      !!                  ***  ROUTINE tra_ldf  *** 
    52       !!  
     52      !! 
    5353      !! ** Purpose :   compute the lateral ocean tracer physics. 
    5454      !!---------------------------------------------------------------------- 
    … …  
    120120      !!---------------------------------------------------------------------- 
    121121      !!                  ***  ROUTINE tra_ldf_init  *** 
    122       !!  
     122      !! 
    123123      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion 
    124124      !! 
    125125      !! ** Method  :   set nldf_tra from the namtra_ldf logicals 
    126126      !!---------------------------------------------------------------------- 
    127       INTEGER ::   ioptio, ierr   ! temporary integers  
     127      INTEGER ::   ioptio, ierr   ! temporary integers 
    128128      !!---------------------------------------------------------------------- 
    129129      ! 

  • NEMO/trunk/src/OCE/TRA/traldf_iso.F90

    r13982 r14072  
    1515   !!---------------------------------------------------------------------- 
    1616   !!   tra_ldf_iso   : update the tracer trend with the horizontal component of a iso-neutral laplacian operator 
    17    !!                   and with the vertical part of the isopycnal or geopotential s-coord. operator  
     17   !!                   and with the vertical part of the isopycnal or geopotential s-coord. operator 
    1818   !!---------------------------------------------------------------------- 
    1919   USE oce            ! ocean dynamics and active tracers 
    … …  
    7979      !!                  ***  ROUTINE tra_ldf_iso  *** 
    8080      !! 
    81       !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive  
    82       !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and  
     81      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
     82      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and 
    8383      !!      add it to the general trend of tracer equation. 
    8484      !! 
    85       !! ** Method  :   The horizontal component of the lateral diffusive trends  
     85      !! ** Method  :   The horizontal component of the lateral diffusive trends 
    8686      !!      is provided by a 2nd order operator rotated along neural or geopo- 
    8787      !!      tential surfaces to which an eddy induced advection can be added 
    … …  
    9494      !! 
    9595      !!      2nd part :  horizontal fluxes of the lateral mixing operator 
    96       !!      ========     
     96      !!      ======== 
    9797      !!         zftu =  pahu e2u*e3u/e1u di[ tb ] 
    9898      !!               - pahu e2u*uslp    dk[ mi(mk(tb)) ] 
    … …  
    165165      ELSE                    ;   zsign = -1._wp 
    166166      ENDIF 
    167           
     167 
    168168      !!---------------------------------------------------------------------- 
    169169      !!   0 - calculate  ah_wslp2 and akz 
    … …  
    223223      DO jn = 1, kjpt                                            ! tracer loop 
    224224         !                                                       ! =========== 
    225          !                                                
    226          !!---------------------------------------------------------------------- 
    227          !!   I - masked horizontal derivative  
     225         ! 
     226         !!---------------------------------------------------------------------- 
     227         !!   I - masked horizontal derivative 
    228228         !!---------------------------------------------------------------------- 
    229229!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient.... 
    … …  
    232232         !!end 
    233233 
    234          ! Horizontal tracer gradient  
     234         ! Horizontal tracer gradient 
    235235         DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    236236            zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    … …  
    239239         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient 
    240240            DO_2D( 1, 0, 1, 0 )           ! bottom correction (partial bottom cell) 
    241                zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)           
     241               zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
    242242               zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    243243            END_2D 
    244244            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity 
    245245               DO_2D( 1, 0, 1, 0 ) 
    246                   IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)           
    247                   IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)      
     246                  IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 
     247                  IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn) 
    248248               END_2D 
    249249            ENDIF 
    … …  
    283283               zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   & 
    284284                  &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      & 
    285                   &                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                   
     285                  &                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk) 
    286286            END_2D 
    287287            ! 
    … …  
    291291                  &                                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    292292            END_2D 
    293          END DO                                        !   End of slab   
     293         END DO                                        !   End of slab 
    294294 
    295295         !!---------------------------------------------------------------------- 
    … …  
    301301         !                          ! Surface and bottom vertical fluxes set to zero 
    302302         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp 
    303           
     303 
    304304         DO_3D( 0, 0, 0, 0, 2, jpkm1 )    ! interior (2=<jk=<jpk-1) 
    305305            ! 
    … …  
    330330            END_3D 
    331331            ! 
    332          ELSE                                   ! bilaplacian  
     332         ELSE                                   ! bilaplacian 
    333333            SELECT CASE( kpass ) 
    334334            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
    … …  
    346346            END SELECT 
    347347         ENDIF 
    348          !          
     348         ! 
    349349         DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==! 
    350350            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * r1_e1e2t(ji,jj)   & 

  • NEMO/trunk/src/OCE/TRA/traldf_lap_blp.F90

    r13982 r14072  
    44   !! Ocean tracers:  lateral diffusivity trend  (laplacian and bilaplacian) 
    55   !!============================================================================== 
    6    !! History :  3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian  
     6   !! History :  3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian 
    77   !!---------------------------------------------------------------------- 
    88 
    … …  
    7474      !!---------------------------------------------------------------------- 
    7575      !!                  ***  ROUTINE tra_ldf_lap  *** 
    76       !!                    
    77       !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive  
     76      !! 
     77      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
    7878      !!      trend and add it to the general trend of tracer equation. 
    7979      !! 
    8080      !! ** Method  :   Second order diffusive operator evaluated using before 
    81       !!      fields (forward time scheme). The horizontal diffusive trends of  
     81      !!      fields (forward time scheme). The horizontal diffusive trends of 
    8282      !!      the tracer is given by: 
    8383      !!          difft = 1/(e1e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ] 
    … …  
    8686      !!          pt_rhs = pt_rhs + difft 
    8787      !! 
    88       !! ** Action  : - Update pt_rhs arrays with the before iso-level  
     88      !! ** Action  : - Update pt_rhs arrays with the before iso-level 
    8989      !!                harmonic mixing trend. 
    9090      !!---------------------------------------------------------------------- 
    … …  
    139139      !                             ! =========== ! 
    140140      DO jn = 1, kjpt               ! tracer loop ! 
    141          !                          ! =========== !     
    142          !                                
     141         !                          ! =========== ! 
     142         ! 
    143143         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )            !== First derivative (gradient)  ==! 
    144144            ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) 
    … …  
    152152            IF( ln_isfcav ) THEN                             ! top in ocean cavities only 
    153153               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    154                   IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn)  
    155                   IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn)  
     154                  IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 
     155                  IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 
    156156               END_2D 
    157157            ENDIF 
    … …  
    177177      ! 
    178178   END SUBROUTINE tra_ldf_lap_t 
    179     
     179 
    180180 
    181181   SUBROUTINE tra_ldf_blp( kt, Kmm, kit000, cdtype, pahu, pahv  ,             & 
    … …  
    184184      !!---------------------------------------------------------------------- 
    185185      !!                 ***  ROUTINE tra_ldf_blp  *** 
    186       !!                     
    187       !! ** Purpose :   Compute the before lateral tracer diffusive  
     186      !! 
     187      !! ** Purpose :   Compute the before lateral tracer diffusive 
    188188      !!      trend and add it to the general trend of tracer equation. 
    189189      !! 
    … …  
    238238      ! NOTE: [tiling-comms-merge] Needed for both nn_hls as tra_ldf_iso and tra_ldf_triad have not yet been adjusted to work with nn_hls = 2. In the zps case the lbc_lnk in zps_hde handles this, but in the zco case zlap always needs this lbc_lnk. I did try adjusting the bounds in tra_ldf_iso and tra_ldf_triad so this lbc_lnk was only needed for nn_hls = 1, but this was not correct and I did not have time to figure out why 
    239239      CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
    240       !                                               ! Partial top/bottom cell: GRADh( zlap )   
     240      !                                               ! Partial top/bottom cell: GRADh( zlap ) 
    241241      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom 
    242       ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, Kmm, kjpt, zlap, zglu, zglv )              ! only bottom  
     242      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, Kmm, kjpt, zlap, zglu, zglv )              ! only bottom 
    243243      ENDIF 
    244244      ! 

  • NEMO/trunk/src/OCE/TRA/traldf_triad.F90

    r13982 r14072  
    145145      ELSE                    ;   zsign = -1._wp 
    146146      ENDIF 
    147       !     
     147      ! 
    148148      !!---------------------------------------------------------------------- 
    149149      !!   0 - calculate  ah_wslp2, akz, and optionally zpsi_uw, zpsi_vw 
    … …  
    175175         END DO 
    176176         ! 
    177          DO jp = 0, 1                            ! j-k triads  
     177         DO jp = 0, 1                            ! j-k triads 
    178178            DO kp = 0, 1 
    179179               DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    … …  
    264264            IF( ln_isfcav ) THEN                   ! top level (ocean cavities only) 
    265265               DO_2D( 1, 0, 1, 0 ) 
    266                   IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn)  
    267                   IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn)  
     266                  IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 
     267                  IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) 
    268268               END_2D 
    269269            ENDIF 
    … …  
    392392                  &                            * (  pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 
    393393            END_3D 
    394          ELSE                                   ! bilaplacian  
     394         ELSE                                   ! bilaplacian 
    395395            SELECT CASE( kpass ) 
    396396            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
    … …  
    405405                     &                               + akz     (ji,jj,jk) * ( pt2(ji,jj,jk-1,jn) - pt2(ji,jj,jk,jn) )   ) 
    406406               END_3D 
    407             END SELECT  
     407            END SELECT 
    408408         ENDIF 
    409409         ! 

  • NEMO/trunk/src/OCE/TRA/tranpc.F90

    r13982 r14072  
    9797         IF( l_LB_debug ) THEN 
    9898            ! Location of 1 known convection site to follow what's happening in the water column 
    99             ilc1 = 45 ;  jlc1 = 3 ; !  ORCA2 4x4, Antarctic coast, more than 2 unstable portions in the  water column...            
     99            ilc1 = 45 ;  jlc1 = 3 ; !  ORCA2 4x4, Antarctic coast, more than 2 unstable portions in the  water column... 
    100100            nncpu = 1  ;            ! the CPU domain contains the convection spot 
    101             klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point...           
     101            klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point... 
    102102         ENDIF 
    103103         ! 
    … …  
    116116            ! 
    117117            IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points 
    118                !                                     ! consider one ocean column  
     118               !                                     ! consider one ocean column 
    119119               zvts(:,jp_tem) = pts(ji,jj,:,jp_tem,Kaa)      ! temperature 
    120120               zvts(:,jp_sal) = pts(ji,jj,:,jp_sal,Kaa)      ! salinity 
    121121               ! 
    122                zvab(:,jp_tem)  = zab(ji,jj,:,jp_tem)     ! Alpha  
    123                zvab(:,jp_sal)  = zab(ji,jj,:,jp_sal)     ! Beta   
    124                zvn2(:)         = zn2(ji,jj,:)            ! N^2  
     122               zvab(:,jp_tem)  = zab(ji,jj,:,jp_tem)     ! Alpha 
     123               zvab(:,jp_sal)  = zab(ji,jj,:,jp_sal)     ! Beta 
     124               zvn2(:)         = zn2(ji,jj,:)            ! N^2 
    125125               ! 
    126126               IF( l_LB_debug ) THEN                  !LB debug: 
    … …  
    128128                  IF( ( ji == ilc1 ).AND.( jj == jlc1 ) ) lp_monitor_point = .TRUE. 
    129129                  ! writing only if on CPU domain where conv region is: 
    130                   lp_monitor_point = (narea == nncpu).AND.lp_monitor_point                       
     130                  lp_monitor_point = (narea == nncpu).AND.lp_monitor_point 
    131131               ENDIF                                  !LB debug  end 
    132132               ! 
    … …  
    140140                  ! 
    141141                  jiter = jiter + 1 
    142                   !  
     142                  ! 
    143143                  IF( jiter >= 400 ) EXIT 
    144144                  ! 
    … …  
    155155                        ilayer = ilayer + 1    ! yet another instable portion of the water column found.... 
    156156                        ! 
    157                         IF( lp_monitor_point ) THEN  
     157                        IF( lp_monitor_point ) THEN 
    158158                           WRITE(numout,*) 
    159159                           IF( ilayer == 1 .AND. jiter == 1 ) THEN   ! first time a column is spoted with an instability 
    … …  
    195195                        zsum_beta = 0._wp 
    196196                        zsum_z    = 0._wp 
    197                                                   
     197 
    198198                        DO jk = ikup, ikbot      ! Inside the instable (and overlying neutral) portion of the column 
    199199                           ! 
    … …  
    204204                           zsum_beta = zsum_beta + zvab(jk,jp_sal)*zdz 
    205205                           zsum_z    = zsum_z    + zdz 
    206                            !                               
     206                           ! 
    207207                           IF( jk == ikbot ) EXIT ! avoid array-index overshoot in case ikbot = jpk, cause we're calling jk+1 next line 
    208208                           !! EXIT when we have reached the last layer that is instable (N2<0) or neutral (N2=0): 
    209209                           IF( zvn2(jk+1) > zn2_zero ) EXIT 
    210210                        END DO 
    211                         
     211 
    212212                        ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative or neutral N2 
    213213                        IF( ikup == ikdown )   CALL ctl_stop( 'tra_npc :  PROBLEM #2') 
    … …  
    235235                           zvab(jk,jp_sal) = zbeta 
    236236                        END DO 
    237                          
    238                          
     237 
     238 
    239239                        !! Updating N2 in the relvant portion of the water column 
    240240                        !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion 
    241241                        !! => Need to re-compute N2! will use Alpha and Beta! 
    242                          
     242 
    243243                        ikup   = MAX(2,ikup)         ! ikup can never be 1 ! 
    244244                        ik_low = MIN(ikdown+1,ikbot) ! we must go 1 point deeper than ikdown! 
    245                          
     245 
    246246                        DO jk = ikup, ik_low              ! we must go 1 point deeper than ikdown! 
    247247 
    … …  
    263263 
    264264                        END DO 
    265                       
     265 
    266266                        ikp = MIN(ikdown+1,ikbot) 
    267                          
     267 
    268268 
    269269                     ENDIF  !IF( zvn2(ikp) < 0. ) 
    … …  
    275275 
    276276                  IF( ikp /= ikbot )   CALL ctl_stop( 'tra_npc :  PROBLEM #3') 
    277                   
     277 
    278278                  ! ******* At this stage ikp == ikbot ! ******* 
    279                   
     279 
    280280                  IF( ilayer > 0 ) THEN      !! least an unstable layer has been found 
    281281                     ! 

  • NEMO/trunk/src/OCE/TRA/traqsr.F90

    r14053 r14072  
    99   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module 
    1010   !!             -   !  2005-11  (G. Madec) zco, zps, sco coordinate 
    11    !!            3.2  !  2009-04  (G. Madec & NEMO team)  
    12    !!            3.6  !  2012-05  (C. Rousset) store attenuation coef for use in ice model  
     11   !!            3.2  !  2009-04  (G. Madec & NEMO team) 
     12   !!            3.6  !  2012-05  (C. Rousset) store attenuation coef for use in ice model 
    1313   !!            3.6  !  2015-12  (O. Aumont, J. Jouanno, C. Ethe) use vertical profile of chlorophyll 
    14    !!            3.7  !  2015-11  (G. Madec, A. Coward)  remove optimisation for fix volume  
     14   !!            3.7  !  2015-11  (G. Madec, A. Coward)  remove optimisation for fix volume 
    1515   !!---------------------------------------------------------------------- 
    1616 
    1717   !!---------------------------------------------------------------------- 
    18    !!   tra_qsr       : temperature trend due to the penetration of solar radiation  
    19    !!   tra_qsr_init  : initialization of the qsr penetration  
     18   !!   tra_qsr       : temperature trend due to the penetration of solar radiation 
     19   !!   tra_qsr_init  : initialization of the qsr penetration 
    2020   !!---------------------------------------------------------------------- 
    2121   USE oce            ! ocean dynamics and active tracers 
    … …  
    4545   !                                 !!* Namelist namtra_qsr: penetrative solar radiation 
    4646   LOGICAL , PUBLIC ::   ln_traqsr    !: light absorption (qsr) flag 
    47    LOGICAL , PUBLIC ::   ln_qsr_rgb   !: Red-Green-Blue light absorption flag   
     47   LOGICAL , PUBLIC ::   ln_qsr_rgb   !: Red-Green-Blue light absorption flag 
    4848   LOGICAL , PUBLIC ::   ln_qsr_2bd   !: 2 band         light absorption flag 
    4949   LOGICAL , PUBLIC ::   ln_qsr_bio   !: bio-model      light absorption flag 
    … …  
    5454   ! 
    5555   INTEGER , PUBLIC ::   nksr         !: levels below which the light cannot penetrate (depth larger than 391 m) 
    56   
     56 
    5757   INTEGER, PARAMETER ::   np_RGB  = 1   ! R-G-B     light penetration with constant Chlorophyll 
    5858   INTEGER, PARAMETER ::   np_RGBc = 2   ! R-G-B     light penetration with Chlorophyll data 
    … …  
    8888      !!      Considering the 2 wavebands case: 
    8989      !!         I(k) = Qsr*( rn_abs*EXP(z(k)/rn_si0) + (1.-rn_abs)*EXP(z(k)/rn_si1) ) 
    90       !!         The temperature trend associated with the solar radiation penetration  
     90      !!         The temperature trend associated with the solar radiation penetration 
    9191      !!         is given by : zta = 1/e3t dk[ I ] / (rho0*Cp) 
    9292      !!         At the bottom, boudary condition for the radiation is no flux : 
    9393      !!      all heat which has not been absorbed in the above levels is put 
    9494      !!      in the last ocean level. 
    95       !!         The computation is only done down to the level where  
    96       !!      I(k) < 1.e-15 W/m2 (i.e. over the top nksr levels) .  
     95      !!         The computation is only done down to the level where 
     96      !!      I(k) < 1.e-15 W/m2 (i.e. over the top nksr levels) . 
    9797      !! 
    9898      !! ** Action  : - update ta with the penetrative solar radiation trend 
    … …  
    193193            DO_2D( isj, iej, isi, iei ) 
    194194                       ! zlogc = log(zchl) 
    195                zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) )      
     195               zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) ) 
    196196                       ! zc1 : log(zCze)  = log (1.12  * zchl**0.803) 
    197                zc1   = 0.113328685307 + 0.803 * zlogc                          
     197               zc1   = 0.113328685307 + 0.803 * zlogc 
    198198                       ! zc2 : log(zCtot) = log(40.6  * zchl**0.459) 
    199                zc2   = 3.703768066608 + 0.459 * zlogc                            
     199               zc2   = 3.703768066608 + 0.459 * zlogc 
    200200                       ! zc3 : log(zze)   = log(568.2 * zCtot**(-0.746)) 
    201                zc3   = 6.34247346942  - 0.746 * zc2                            
     201               zc3   = 6.34247346942  - 0.746 * zc2 
    202202                       ! IF( log(zze) > log(102.) ) log(zze) = log(200.0 * zCtot**(-0.293)) 
    203                IF( zc3 > 4.62497281328 ) zc3 = 5.298317366548 - 0.293 * zc2         
    204                !    
     203               IF( zc3 > 4.62497281328 ) zc3 = 5.298317366548 - 0.293 * zc2 
     204               ! 
    205205               ze0(ji,jj) = zlogc                                                 ! ze0 = log(zchl) 
    206206               ze1(ji,jj) = EXP( zc1 )                                            ! ze1 = zCze 
    … …  
    208208               ze3(ji,jj) = EXP( - zc3 )                                          ! ze3 = 1/zze 
    209209            END_2D 
    210              
     210 
    211211! 
    212212            DO_3D( isj, iej, isi, iei, 1, nksr + 1 ) 
    … …  
    230230         ELSE                                !* constant chlorophyll 
    231231            zchl = 0.05 
    232             ! NB. make sure constant value is such that:  
     232            ! NB. make sure constant value is such that: 
    233233            zchl = MIN( 10. , MAX( 0.03, zchl ) ) 
    234234            ! Convert chlorophyll value to attenuation coefficient look-up table index 
    … …  
    245245            ze2(ji,jj) = zcoef  * qsr(ji,jj) 
    246246            ze3(ji,jj) = zcoef  * qsr(ji,jj) 
    247             ! store the surface SW radiation; re-use the surface ztmp3d array  
     247            ! store the surface SW radiation; re-use the surface ztmp3d array 
    248248            ! since the surface attenuation coefficient is not used 
    249249            ztmp3d(ji,jj,1) =       qsr(ji,jj) 
    … …  
    269269         END_3D 
    270270         ! 
    271          DEALLOCATE( ze0 , ze1 , ze2 , ze3 , ztmp3d )  
     271         DEALLOCATE( ze0 , ze1 , ze2 , ze3 , ztmp3d ) 
    272272         ! 
    273273      CASE( np_2BD  )            !==  2-bands fluxes  ==! 
    … …  
    278278            zc0 = zz0 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi1r ) 
    279279            zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r ) 
    280             qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) )  
     280            qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) ) 
    281281         END_3D 
    282282         ! 
    … …  
    341341      !!      from two length scale of penetration (rn_si0,rn_si1) and a ratio 
    342342      !!      (rn_abs). These parameters are read in the namtra_qsr namelist. The 
    343       !!      default values correspond to clear water (type I in Jerlov'  
     343      !!      default values correspond to clear water (type I in Jerlov' 
    344344      !!      (1968) classification. 
    345345      !!         called by tra_qsr at the first timestep (nit000) 
    … …  
    391391         &                               ' 2 bands, 3 RGB bands or bio-model light penetration' ) 
    392392      ! 
    393       IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr = np_RGB  
     393      IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr = np_RGB 
    394394      IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr = np_RGBc 
    395395      IF( ln_qsr_2bd                      )   nqsr = np_2BD 
    … …  
    401401      ! 
    402402      SELECT CASE( nqsr ) 
    403       !                                
     403      ! 
    404404      CASE( np_RGB , np_RGBc )         !==  Red-Green-Blue light penetration  ==! 
    405          !                              
     405         ! 
    406406         IF(lwp)   WRITE(numout,*) '   ==>>>   R-G-B   light penetration ' 
    407407         ! 
    408408         CALL trc_oce_rgb( rkrgb )                 ! tabulated attenuation coef. 
    409          !                                    
     409         ! 
    410410         nksr = trc_oce_ext_lev( r_si2, 33._wp )   ! level of light extinction 
    411411         ! 
    … …  
    441441         ! 
    442442         CALL trc_oce_rgb( rkrgb )                 ! tabulated attenuation coef. 
    443          !                                    
     443         ! 
    444444         nksr = trc_oce_ext_lev( r_si2, 33._wp )   ! level of light extinction 
    445445         ! 

  • NEMO/trunk/src/OCE/TRA/trasbc.F90

    r14053 r14072  
    99   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps 
    1010   !!             -   !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC 
    11    !!            3.6  !  2014-11  (P. Mathiot) isf melting forcing  
     11   !!            3.6  !  2014-11  (P. Mathiot) isf melting forcing 
    1212   !!            4.1  !  2019-09  (P. Mathiot) isf moved in traisf 
    1313   !!---------------------------------------------------------------------- 
    … …  
    2121   USE phycst         ! physical constant 
    2222   USE eosbn2         ! Equation Of State 
    23    USE sbcmod         ! ln_rnf   
    24    USE sbcrnf         ! River runoff   
     23   USE sbcmod         ! ln_rnf 
     24   USE sbcrnf         ! River runoff 
    2525   USE traqsr         ! solar radiation penetration 
    2626   USE trd_oce        ! trends: ocean variables 
    27    USE trdtra         ! trends manager: tracers  
    28 #if defined key_asminc    
     27   USE trdtra         ! trends manager: tracers 
     28#if defined key_asminc 
    2929   USE asminc         ! Assimilation increment 
    3030#endif 
    … …  
    5454      !!---------------------------------------------------------------------- 
    5555      !!                  ***  ROUTINE tra_sbc  *** 
    56       !!                    
     56      !! 
    5757      !! ** Purpose :   Compute the tracer surface boundary condition trend of 
    5858      !!      (flux through the interface, concentration/dilution effect) 
    5959      !!      and add it to the general trend of tracer equations. 
    6060      !! 
    61       !! ** Method :   The (air+ice)-sea flux has two components:  
    62       !!      (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface);  
    63       !!      (2) Fwe , tracer carried with the water that is exchanged with air+ice.  
     61      !! ** Method :   The (air+ice)-sea flux has two components: 
     62      !!      (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface); 
     63      !!      (2) Fwe , tracer carried with the water that is exchanged with air+ice. 
    6464      !!               The input forcing fields (emp, rnf, sfx) contain Fext+Fwe, 
    6565      !!             they are simply added to the tracer trend (ts(Krhs)). 
    … …  
    6969      !!             concentration/dilution effect associated with water exchanges. 
    7070      !! 
    71       !! ** Action  : - Update ts(Krhs) with the surface boundary condition trend  
     71      !! ** Action  : - Update ts(Krhs) with the surface boundary condition trend 
    7272      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T) 
    7373      !!---------------------------------------------------------------------- 
    … …  
    143143         sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting 
    144144      END_2D 
    145       IF( ln_linssh ) THEN                !* linear free surface   
     145      IF( ln_linssh ) THEN                !* linear free surface 
    146146         DO_2D( isj, iej, isi, iei )                    !==>> add concentration/dilution effect due to constant volume cell 
    147147            sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 
    … …  
    161161         END_2D 
    162162      END DO 
    163       !                   
     163      ! 
    164164      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    165165         IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==! 
    … …  
    173173      !---------------------------------------- 
    174174      ! 
    175       IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff  
     175      IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff 
    176176         zfact = 0.5_wp 
    177177         DO_2D( 0, 0, 0, 0 ) 
    … …  
    182182                                        &                      +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep 
    183183                  IF( ln_rnf_sal )   pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)                                  & 
    184                                         &                      +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep  
     184                                        &                      +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
    185185               END DO 
    186186            ENDIF 
    … …  
    201201      IF( ln_sshinc ) THEN         ! input of heat and salt due to assimilation 
    202202          ! 
    203          IF( ln_linssh ) THEN  
     203         IF( ln_linssh ) THEN 
    204204            DO_2D( 0, 0, 0, 0 ) 
    205205               ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm) 

  • NEMO/trunk/src/OCE/TRA/trazdf.F90

    r14010 r14072  
    1717   USE phycst         ! physical constant 
    1818   USE zdf_oce        ! ocean vertical physics variables 
    19    USE zdfmfc         ! Mass FLux Convection  
     19   USE zdfmfc         ! Mass FLux Convection 
    2020   USE sbc_oce        ! surface boundary condition: ocean 
    2121   USE ldftra         ! lateral diffusion: eddy diffusivity 
    22    USE ldfslp         ! lateral diffusion: iso-neutral slope  
     22   USE ldfslp         ! lateral diffusion: iso-neutral slope 
    2323   USE trd_oce        ! trends: ocean variables 
    2424   USE trdtra         ! trends: tracer trend manager 
    … …  
    7777      ! 
    7878      !                                      !* compute lateral mixing trend and add it to the general trend 
    79       CALL tra_zdf_imp( kt, nit000, 'TRA', rDt, Kbb, Kmm, Krhs, pts, Kaa, jpts )  
     79      CALL tra_zdf_imp( kt, nit000, 'TRA', rDt, Kbb, Kmm, Krhs, pts, Kaa, jpts ) 
    8080 
    8181!!gm WHY here !   and I don't like that ! 
    … …  
    113113   END SUBROUTINE tra_zdf 
    114114 
    115   
    116    SUBROUTINE tra_zdf_imp( kt, kit000, cdtype, p2dt, Kbb, Kmm, Krhs, pt, Kaa, kjpt )  
     115 
     116   SUBROUTINE tra_zdf_imp( kt, kit000, cdtype, p2dt, Kbb, Kmm, Krhs, pt, Kaa, kjpt ) 
    117117      !!---------------------------------------------------------------------- 
    118118      !!                  ***  ROUTINE tra_zdf_imp  *** 
    119119      !! 
    120120      !! ** Purpose :   Compute the after tracer through a implicit computation 
    121       !!     of the vertical tracer diffusion (including the vertical component  
    122       !!     of lateral mixing (only for 2nd order operator, for fourth order  
    123       !!     it is already computed and add to the general trend in traldf)  
     121      !!     of the vertical tracer diffusion (including the vertical component 
     122      !!     of lateral mixing (only for 2nd order operator, for fourth order 
     123      !!     it is already computed and add to the general trend in traldf) 
    124124      !! 
    125125      !! ** Method  :  The vertical diffusion of a tracer ,t , is given by: 
    … …  
    169169            zwt(:,:,1) = 0._wp 
    170170            ! 
    171             IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution  
    172                IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator  
     171            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution 
     172               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator 
    173173                  DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    174                      zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)   
     174                     zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk) 
    175175                  END_3D 
    176176               ELSE                          ! standard or triad iso-neutral operator 
    … …  
    220220            !   The solution will be in the 4d array pta. 
    221221            !   The 3d array zwt is used as a work space array. 
    222             !   En route to the solution pt(:,:,:,:,Kaa) is used a to evaluate the rhs and then  
     222            !   En route to the solution pt(:,:,:,:,Kaa) is used a to evaluate the rhs and then 
    223223            !   used as a work space array: its value is modified. 
    224224            ! 
    … …  
    230230            END_3D 
    231231            ! 
    232          ENDIF  
    233          !          
     232         ENDIF 
     233         ! 
    234234         ! Modification of rhs to add MF scheme 
    235235         IF ( ln_zdfmfc ) THEN 
    … …  
    239239         DO_2D( 0, 0, 0, 0 )         !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    240240            pt(ji,jj,1,jn,Kaa) =        e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb)    & 
    241                &               + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs)  
     241               &               + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 
    242242         END_2D 
    243243         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 

  • NEMO/trunk/src/OCE/TRA/zpshde.F90

    r13982 r14072  
    77   !!   NEMO     1.0  !  2002-08  (G. Madec E. Durand)  Optimization and Free form 
    88   !!             -   !  2004-03  (C. Ethe)  adapted for passive tracers 
    9    !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA  
     9   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
    1010   !!            3.6  !  2014-11  (P. Mathiot) Add zps_hde_isf (needed to open a cavity) 
    1111   !!====================================================================== 
    12     
     12 
    1313   !!---------------------------------------------------------------------- 
    1414   !!   zps_hde      :  Horizontal DErivative of T, S and rd at the last 
    … …  
    6666      !!---------------------------------------------------------------------- 
    6767      !!                     ***  ROUTINE zps_hde  *** 
    68       !!                     
     68      !! 
    6969      !! ** Purpose :   Compute the horizontal derivative of T, S and rho 
    7070      !!      at u- and v-points with a linear interpolation for z-coordinate 
    7171      !!      with partial steps. 
    7272      !! 
    73       !! ** Method  :   In z-coord with partial steps, scale factors on last  
    74       !!      levels are different for each grid point, so that T, S and rd  
     73      !! ** Method  :   In z-coord with partial steps, scale factors on last 
     74      !!      levels are different for each grid point, so that T, S and rd 
    7575      !!      points are not at the same depth as in z-coord. To have horizontal 
    76       !!      gradients again, we interpolate T and S at the good depth :  
    77       !!      Linear interpolation of T, S    
     76      !!      gradients again, we interpolate T and S at the good depth : 
     77      !!      Linear interpolation of T, S 
    7878      !!         Computation of di(tb) and dj(tb) by vertical interpolation: 
    7979      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~ 
    8080      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~ 
    8181      !!         This formulation computes the two cases: 
    82       !!                 CASE 1                   CASE 2   
     82      !!                 CASE 1                   CASE 2 
    8383      !!         k-1  ___ ___________   k-1   ___ ___________ 
    8484      !!                    Ti  T~                  T~  Ti+1 
    … …  
    8787      !!                  |   |____                ____|   | 
    8888      !!              ___ |   |   |           ___  |   |   | 
    89       !!                   
     89      !! 
    9090      !!      case 1->   e3w(i+1,:,:,Kmm) >= e3w(i,:,:,Kmm) ( and e3w(:,j+1,:,Kmm) >= e3w(:,j,:,Kmm) ) then 
    9191      !!          t~ = t(i+1,j  ,k) + (e3w(i+1,j,k,Kmm) - e3w(i,j,k,Kmm)) * dk(Ti+1)/e3w(i+1,j,k,Kmm) 
    … …  
    9595      !!          t~ = t(i,j,k) + (e3w(i,j,k,Kmm) - e3w(i+1,j,k,Kmm)) * dk(Ti)/e3w(i,j,k,Kmm) 
    9696      !!        ( t~ = t(i,j,k) + (e3w(i,j,k,Kmm) - e3w(i,j+1,k,Kmm)) * dk(Tj)/e3w(i,j,k,Kmm) ) 
    97       !!          Idem for di(s) and dj(s)           
     97      !!          Idem for di(s) and dj(s) 
    9898      !! 
    9999      !!      For rho, we call eos which will compute rd~(t~,s~) at the right 
    … …  
    175175      ! 
    176176      IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    177       !                 
     177      ! 
    178178      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    179179         pgru(:,:) = 0._wp 
    … …  
    192192         END_2D 
    193193         ! 
    194          CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj  
    195          CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
     194         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj 
     195         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj 
    196196         ! 
    197197         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! Gradient of density at the last level 
    … …  
    244244      !!---------------------------------------------------------------------- 
    245245      !!                     ***  ROUTINE zps_hde_isf  *** 
    246       !!                     
     246      !! 
    247247      !! ** Purpose :   Compute the horizontal derivative of T, S and rho 
    248248      !!      at u- and v-points with a linear interpolation for z-coordinate 
    249249      !!      with partial steps for top (ice shelf) and bottom. 
    250250      !! 
    251       !! ** Method  :   In z-coord with partial steps, scale factors on last  
    252       !!      levels are different for each grid point, so that T, S and rd  
     251      !! ** Method  :   In z-coord with partial steps, scale factors on last 
     252      !!      levels are different for each grid point, so that T, S and rd 
    253253      !!      points are not at the same depth as in z-coord. To have horizontal 
    254254      !!      gradients again, we interpolate T and S at the good depth : 
    255255      !!      For the bottom case: 
    256       !!      Linear interpolation of T, S    
     256      !!      Linear interpolation of T, S 
    257257      !!         Computation of di(tb) and dj(tb) by vertical interpolation: 
    258258      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~ 
    259259      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~ 
    260260      !!         This formulation computes the two cases: 
    261       !!                 CASE 1                   CASE 2   
     261      !!                 CASE 1                   CASE 2 
    262262      !!         k-1  ___ ___________   k-1   ___ ___________ 
    263263      !!                    Ti  T~                  T~  Ti+1 
    … …  
    266266      !!                  |   |____                ____|   | 
    267267      !!              ___ |   |   |           ___  |   |   | 
    268       !!                   
     268      !! 
    269269      !!      case 1->   e3w(i+1,j,k,Kmm) >= e3w(i,j,k,Kmm) ( and e3w(i,j+1,k,Kmm) >= e3w(i,j,k,Kmm) ) then 
    270270      !!          t~ = t(i+1,j  ,k) + (e3w(i+1,j  ,k,Kmm) - e3w(i,j,k,Kmm)) * dk(Ti+1)/e3w(i+1,j  ,k,Kmm) 
    … …  
    274274      !!          t~ = t(i,j,k) + (e3w(i,j,k,Kmm) - e3w(i+1,j  ,k,Kmm)) * dk(Ti)/e3w(i,j,k,Kmm) 
    275275      !!        ( t~ = t(i,j,k) + (e3w(i,j,k,Kmm) - e3w(i  ,j+1,k,Kmm)) * dk(Tj)/e3w(i,j,k,Kmm) ) 
    276       !!          Idem for di(s) and dj(s)           
     276      !!          Idem for di(s) and dj(s) 
    277277      !! 
    278278      !!      For rho, we call eos which will compute rd~(t~,s~) at the right 
    … …  
    364364      ! horizontal derivative of density anomalies (rd) 
    365365      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level 
    366          pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ;  
     366         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ; 
    367367         ! 
    368368         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    … …  
    418418            ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 
    419419            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
    420             ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm)  
     420            ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 
    421421 
    422422            ! i- direction 
    … …  
    463463            ikv = mikv(ji,jj) 
    464464            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
    465             ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm)  
     465            ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 
    466466            ! 
    467467            IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)    ! i-direction: case 1 
    … …  
    475475         END_2D 
    476476         ! 
    477          CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj  
    478          CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
    479          ! 
    480          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    481             iku = miku(ji,jj)  
    482             ikv = mikv(ji,jj)  
     477         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj 
     478         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj 
     479         ! 
     480         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     481            iku = miku(ji,jj) 
     482            ikv = mikv(ji,jj) 
    483483            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
    484             ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm)  
     484            ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 
    485485 
    486486            IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj      ) - prd(ji,jj,iku) ) ! i: 1 
    … …  
    494494         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions 
    495495         ! 
    496       END IF   
     496      END IF 
    497497      ! 
    498498      IF( ln_timing )   CALL timing_stop( 'zps_hde_isf') 

  • NEMO/trunk/src/OCE/TRD/trdini.F90

    r13982 r14072  
    1717   USE trdglo         ! trends: global domain averaged tracers and dynamics 
    1818   USE trdmxl         ! trends: mixed layer averaged trends (tracer only) 
    19    USE trdvor         ! trends: vertical averaged vorticity  
     19   USE trdvor         ! trends: vertical averaged vorticity 
    2020   USE in_out_manager ! I/O manager 
    2121   USE lib_mpp        ! MPP library 
    … …  
    3636      !!---------------------------------------------------------------------- 
    3737      !!                  ***  ROUTINE trd_init  *** 
    38       !!  
     38      !! 
    3939      !! ** Purpose :   Initialization of trend diagnostics 
    4040      !!---------------------------------------------------------------------- 
    … …  
    4343      !! 
    4444      NAMELIST/namtrd/ ln_dyn_trd, ln_KE_trd, ln_vor_trd, ln_dyn_mxl,   & 
    45          &             ln_tra_trd, ln_PE_trd, ln_glo_trd, ln_tra_mxl, nn_trd  
     45         &             ln_tra_trd, ln_PE_trd, ln_glo_trd, ln_tra_mxl, nn_trd 
    4646      !!---------------------------------------------------------------------- 
    4747      ! 
    … …  
    7070      ENDIF 
    7171      ! 
    72       !                             ! trend extraction flags   
    73       l_trdtra = .FALSE.                                                       ! tracers   
     72      !                             ! trend extraction flags 
     73      l_trdtra = .FALSE.                                                       ! tracers 
    7474      IF ( ln_tra_trd .OR. ln_PE_trd .OR. ln_tra_mxl .OR.   & 
    75          & ln_glo_trd                                       )   l_trdtra = .TRUE.  
     75         & ln_glo_trd                                       )   l_trdtra = .TRUE. 
    7676      ! 
    7777      l_trddyn = .FALSE.                                                       ! momentum 
    … …  
    8080      ! 
    8181 
    82 !!gm check the stop below       
     82!!gm check the stop below 
    8383      IF( ln_dyn_mxl )   CALL ctl_stop( 'ML diag on momentum are not yet coded we stop' ) 
    8484      ! 
    … …  
    9797 
    9898!!gm  : Potential BUG : 3D output only for vector invariant form!  add a ctl_stop or code the flux form case 
    99 !!gm  : bug/pb for vertical advection of tracer in vvl case: add T.dt[eta] in the output...  
     99!!gm  : bug/pb for vertical advection of tracer in vvl case: add T.dt[eta] in the output... 
    100100 
    101       !                             ! diagnostic initialization   
     101      !                             ! diagnostic initialization 
    102102      IF( ln_glo_trd )   CALL trd_glo_init( Kmm )      ! global domain averaged trends 
    103       IF( ln_tra_mxl )   CALL trd_mxl_init      ! mixed-layer          trends   
     103      IF( ln_tra_mxl )   CALL trd_mxl_init      ! mixed-layer          trends 
    104104      IF( ln_vor_trd )   CALL trd_vor_init      ! barotropic vorticity trends 
    105105      IF( ln_KE_trd  )   CALL trd_ken_init      ! 3D Kinetic    energy trends 

  • NEMO/trunk/src/OCE/USR/usrdef_nam.F90

    r13982 r14072  
    1212   !!---------------------------------------------------------------------- 
    1313   !!   usr_def_nam   : read user defined namelist and set global domain size 
    14    !!   usr_def_hgr   : initialize the horizontal mesh  
     14   !!   usr_def_hgr   : initialize the horizontal mesh 
    1515   !!---------------------------------------------------------------------- 
    1616   USE dom_oce 
    … …  
    2020   USE in_out_manager ! I/O manager 
    2121   USE lib_mpp        ! MPP library 
    22     
     22 
    2323   IMPLICIT NONE 
    2424   PRIVATE 
    … …  
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    34    !! $Id$  
     34   !! $Id$ 
    3535   !! Software governed by the CeCILL license (see ./LICENSE) 
    3636   !!---------------------------------------------------------------------- 
    … …  
    4040      !!---------------------------------------------------------------------- 
    4141      !!                     ***  ROUTINE dom_nam  *** 
    42       !!                     
     42      !! 
    4343      !! ** Purpose :   read user defined namelist and define the domain size 
    4444      !! 
    … …  
    5151      CHARACTER(len=*), INTENT(out) ::   cd_cfg          ! configuration name 
    5252      INTEGER         , INTENT(out) ::   kk_cfg          ! configuration resolution 
    53       INTEGER         , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes  
    54       INTEGER         , INTENT(out) ::   kperio          ! lateral global domain b.c.  
     53      INTEGER         , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
     54      INTEGER         , INTENT(out) ::   kperio          ! lateral global domain b.c. 
    5555      ! 
    5656      INTEGER ::   ios   ! Local integer 

  • NEMO/trunk/src/OCE/ZDF/zdf_oce.F90

    r14010 r14072  
    4141   LOGICAL , PUBLIC ::   ln_zdfiwm   !: internal wave-induced mixing flag 
    4242   LOGICAL , PUBLIC ::   ln_zdfmfc   !: convection: eddy diffusivity Mass Flux Convection 
    43    !                             ! coefficients  
     43   !                             ! coefficients 
    4444   REAL(wp), PUBLIC ::   rn_avm0     !: vertical eddy viscosity (m2/s) 
    4545   REAL(wp), PUBLIC ::   rn_avt0     !: vertical eddy diffusivity (m2/s) 
    … …  
    5656   !!---------------------------------------------------------------------- 
    5757   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    58    !! $Id$  
     58   !! $Id$ 
    5959   !! Software governed by the CeCILL license (see ./LICENSE) 
    6060   !!---------------------------------------------------------------------- 
    … …  
    6767      ! 
    6868      ALLOCATE( avm (jpi,jpj,jpk) , avm_k(jpi,jpj,jpk) , avs(jpi,jpj,jpk) ,   & 
    69          &      avt (jpi,jpj,jpk) , avt_k(jpi,jpj,jpk) , en (jpi,jpj,jpk) ,   &  
     69         &      avt (jpi,jpj,jpk) , avt_k(jpi,jpj,jpk) , en (jpi,jpj,jpk) ,   & 
    7070         &      avmb(jpk)         , avtb(jpk)          , avtb_2d(jpi,jpj) , STAT = zdf_oce_alloc ) 
    7171         ! 

  • NEMO/trunk/src/OCE/ZDF/zdfgls.F90

    r13970 r14072  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  zdfgls  *** 
    4    !! Ocean physics:  vertical mixing coefficient computed from the gls  
     4   !! Ocean physics:  vertical mixing coefficient computed from the gls 
    55   !!                 turbulent closure parameterization 
    66   !!====================================================================== 
    77   !! History :  3.0  !  2009-09  (G. Reffray)  Original code 
    88   !!            3.3  !  2010-10  (C. Bricaud)  Add in the reference 
    9    !!            4.0  !  2017-04  (G. Madec)  remove CPP keys & avm at t-point only  
     9   !!            4.0  !  2017-04  (G. Madec)  remove CPP keys & avm at t-point only 
    1010   !!             -   !  2017-05  (G. Madec)  add top friction as boundary condition 
    1111   !!---------------------------------------------------------------------- 
    … …  
    1616   !!   gls_rst       : read/write gls restart in ocean restart file 
    1717   !!---------------------------------------------------------------------- 
    18    USE oce            ! ocean dynamics and active tracers  
     18   USE oce            ! ocean dynamics and active tracers 
    1919   USE dom_oce        ! ocean space and time domain 
    2020   USE domvvl         ! ocean space and time domain : variable volume layer 
    … …  
    6464   REAL(wp) ::   rn_hsro           ! Minimum surface roughness 
    6565   REAL(wp) ::   rn_hsri           ! Ice ocean roughness 
    66    REAL(wp) ::   rn_frac_hs        ! Fraction of wave height as surface roughness (if nn_z0_met > 1)  
     66   REAL(wp) ::   rn_frac_hs        ! Fraction of wave height as surface roughness (if nn_z0_met > 1) 
    6767 
    6868   REAL(wp) ::   rcm_sf        =  0.73_wp     ! Shear free turbulence parameters 
    69    REAL(wp) ::   ra_sf         = -2.0_wp      ! Must be negative -2 < ra_sf < -1  
    70    REAL(wp) ::   rl_sf         =  0.2_wp      ! 0 <rl_sf<vkarmn     
     69   REAL(wp) ::   ra_sf         = -2.0_wp      ! Must be negative -2 < ra_sf < -1 
     70   REAL(wp) ::   rl_sf         =  0.2_wp      ! 0 <rl_sf<vkarmn 
    7171   REAL(wp) ::   rghmin        = -0.28_wp 
    7272   REAL(wp) ::   rgh0          =  0.0329_wp 
    … …  
    7575   REAL(wp) ::   ra2           =  0.74_wp 
    7676   REAL(wp) ::   rb1           = 16.60_wp 
    77    REAL(wp) ::   rb2           = 10.10_wp          
    78    REAL(wp) ::   re2           =  1.33_wp          
     77   REAL(wp) ::   rb2           = 10.10_wp 
     78   REAL(wp) ::   re2           =  1.33_wp 
    7979   REAL(wp) ::   rl1           =  0.107_wp 
    8080   REAL(wp) ::   rl2           =  0.0032_wp 
    … …  
    146146      INTEGER  ::   itop, itopp1  !   -       - 
    147147      REAL(wp) ::   zesh2, zsigpsi, zcoef, zex1 , zex2  ! local scalars 
    148       REAL(wp) ::   ztx2, zty2, zup, zdown, zcof, zdir  !   -      -  
     148      REAL(wp) ::   ztx2, zty2, zup, zdown, zcof, zdir  !   -      - 
    149149      REAL(wp) ::   zratio, zrn2, zflxb, sh     , z_en  !   -      - 
    150150      REAL(wp) ::   prod, buoy, diss, zdiss, sm         !   -      - 
    … …  
    153153      REAL(wp), DIMENSION(jpi,jpj)     ::   zdep 
    154154      REAL(wp), DIMENSION(jpi,jpj)     ::   zkar 
    155       REAL(wp), DIMENSION(jpi,jpj)     ::   zflxs       ! Turbulence fluxed induced by internal waves  
     155      REAL(wp), DIMENSION(jpi,jpj)     ::   zflxs       ! Turbulence fluxed induced by internal waves 
    156156      REAL(wp), DIMENSION(jpi,jpj)     ::   zhsro       ! Surface roughness (surface waves) 
    157157      REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra    ! Tapering of wave breaking under sea ice 
    … …  
    167167      ! Preliminary computing 
    168168 
    169       ustar2_surf(:,:) = 0._wp   ;         psi(:,:,:) = 0._wp    
     169      ustar2_surf(:,:) = 0._wp   ;         psi(:,:,:) = 0._wp 
    170170      ustar2_top (:,:) = 0._wp   ;   zwall_psi(:,:,:) = 0._wp 
    171171      ustar2_bot (:,:) = 0._wp 
    … …  
    177177      CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp ) 
    178178      END SELECT 
    179        
     179 
    180180      ! Compute surface, top and bottom friction at T-points 
    181181      DO_2D( 0, 0, 0, 0 )          !==  surface ocean friction 
    … …  
    184184      ! 
    185185      !!gm Rq we may add here r_ke0(_top/_bot) ?  ==>> think about that... 
    186       !     
     186      ! 
    187187      IF( .NOT.ln_drg_OFF ) THEN     !== top/bottom friction   (explicit before friction) 
    188188         DO_2D( 0, 0, 0, 0 )         ! bottom friction (explicit before friction) 
    … …  
    201201         ENDIF 
    202202      ENDIF 
    203     
     203 
    204204      SELECT CASE ( nn_z0_met )      !==  Set surface roughness length  ==! 
    205       CASE ( 0 )                          ! Constant roughness           
     205      CASE ( 0 )                          ! Constant roughness 
    206206         zhsro(:,:) = rn_hsro 
    207207      CASE ( 1 )             ! Standard Charnock formula 
    … …  
    271271         IF( ln_sigpsi ) THEN 
    272272            zsigpsi = MIN( 1._wp, zesh2 / eps(ji,jj,jk) )     ! 0. <= zsigpsi <= 1. 
    273             zwall_psi(ji,jj,jk) = rsc_psi /   &  
     273            zwall_psi(ji,jj,jk) = rsc_psi /   & 
    274274               &     (  zsigpsi * rsc_psi + (1._wp-zsigpsi) * rsc_psi0 / MAX( zwall(ji,jj,jk), 1._wp )  ) 
    275275         ELSE 
    … …  
    286286            &                 / ( e3t(ji,jj,jk  ,Kmm) * e3w(ji,jj,jk,Kmm) ) 
    287287         !                                        ! diagonal 
    288          zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk)  + rn_Dt * zdiss * wmask(ji,jj,jk)  
     288         zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk)  + rn_Dt * zdiss * wmask(ji,jj,jk) 
    289289         !                                        ! right hand side in en 
    290290         en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * zesh2 * wmask(ji,jj,jk) 
    … …  
    302302      SELECT CASE ( nn_bc_surf ) 
    303303      ! 
    304       CASE ( 0 )             ! Dirichlet boundary condition (set e at k=1 & 2)  
     304      CASE ( 0 )             ! Dirichlet boundary condition (set e at k=1 & 2) 
    305305      ! First level 
    306306      en   (:,:,1) = MAX(  rn_emin , rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3  ) 
    … …  
    308308      zd_up(:,:,1) = 0._wp 
    309309      zdiag(:,:,1) = 1._wp 
    310       !  
     310      ! 
    311311      ! One level below 
    312312      en   (:,:,2) =  MAX(  rc02r * ustar2_surf(:,:) * (  1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1 * ((zhsro(:,:)+gdepw(:,:,2,Kmm)) & 
    313313         &                 / zhsro(:,:) )**(1.5_wp*ra_sf)  )**(2._wp/3._wp) , rn_emin   ) 
    314       zd_lw(:,:,2) = 0._wp  
     314      zd_lw(:,:,2) = 0._wp 
    315315      zd_up(:,:,2) = 0._wp 
    316316      zdiag(:,:,2) = 1._wp 
    … …  
    345345      SELECT CASE ( nn_bc_bot ) 
    346346      ! 
    347       CASE ( 0 )             ! Dirichlet  
     347      CASE ( 0 )             ! Dirichlet 
    348348         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin 
    349349         !                      ! Balance between the production and the dissipation terms 
    … …  
    357357            z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin ) 
    358358            ! 
    359             ! Dirichlet condition applied at:  
    360             !     Bottom level (ibot)      &      Just above it (ibotm1)    
     359            ! Dirichlet condition applied at: 
     360            !     Bottom level (ibot)      &      Just above it (ibotm1) 
    361361            zd_lw(ji,jj,ibot) = 0._wp   ;   zd_lw(ji,jj,ibotm1) = 0._wp 
    362362            zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp 
    … …  
    373373               ! 
    374374 !!gm TO BE VERIFIED !!! 
    375                ! Dirichlet condition applied at:  
    376                !     top level (itop)         &      Just below it (itopp1)    
     375               ! Dirichlet condition applied at: 
     376               !     top level (itop)         &      Just below it (itopp1) 
    377377               zd_lw(ji,jj,itop) = 0._wp   ;   zd_lw(ji,jj,itopp1) = 0._wp 
    378378               zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp 
    … …  
    383383         ! 
    384384      CASE ( 1 )             ! Neumman boundary condition 
    385          !                       
     385         ! 
    386386         DO_2D( 0, 0, 0, 0 ) 
    387387            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    … …  
    391391            ! 
    392392            ! Bottom level Dirichlet condition: 
    393             !     Bottom level (ibot)      &      Just above it (ibotm1)    
     393            !     Bottom level (ibot)      &      Just above it (ibotm1) 
    394394            !         Dirichlet            !         Neumann 
    395395            zd_lw(ji,jj,ibot) = 0._wp   !   ! Remove zd_up from zdiag 
    … …  
    405405               ! 
    406406               ! Bottom level Dirichlet condition: 
    407                !     Bottom level (ibot)      &      Just above it (ibotm1)    
     407               !     Bottom level (ibot)      &      Just above it (ibotm1) 
    408408               !         Dirichlet            !         Neumann 
    409409               zd_lw(ji,jj,itop) = 0._wp   !   ! Remove zd_up from zdiag 
    … …  
    427427         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    428428      END_3D 
    429       !                                            ! set the minimum value of tke  
     429      !                                            ! set the minimum value of tke 
    430430      en(:,:,:) = MAX( en(:,:,:), rn_emin ) 
    431431 
    … …  
    455455      CASE( 3 )               ! generic 
    456456         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    457             psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn  
     457            psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn 
    458458         END_3D 
    459459         ! 
    … …  
    470470         ! 
    471471         ! psi / k 
    472          zratio = psi(ji,jj,jk) / eb(ji,jj,jk)  
     472         zratio = psi(ji,jj,jk) / eb(ji,jj,jk) 
    473473         ! 
    474474         ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 zdir = 1 (stable) otherwise zdir = 0 (unstable) 
    … …  
    490490         zesh2 = zdir * ( prod + buoy )          + (1._wp - zdir ) * prod                        ! production term 
    491491         zdiss = zdir * ( diss / psi(ji,jj,jk) ) + (1._wp - zdir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term 
    492          !                                                         
     492         ! 
    493493         ! building the matrix 
    494494         zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk) 
    … …  
    528528         zd_up(:,:,2) = 0._wp 
    529529         zdiag(:,:,2) = 1._wp 
    530          !  
     530         ! 
    531531      CASE ( 1 )             ! Neumann boundary condition on d(psi)/dz 
    532532         ! 
    … …  
    564564      SELECT CASE ( nn_bc_bot )     ! bottom boundary 
    565565      ! 
    566       CASE ( 0 )             ! Dirichlet  
     566      CASE ( 0 )             ! Dirichlet 
    567567         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot 
    568568         !                      ! Balance between the production and the dissipation terms 
    … …  
    585585         ! 
    586586      CASE ( 1 )             ! Neumman boundary condition 
    587          !                       
     587         ! 
    588588         DO_2D( 0, 0, 0, 0 ) 
    589589            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    … …  
    641641      CASE( 2 )               ! k-w 
    642642         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    643             eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk)  
     643            eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 
    644644         END_3D 
    645645         ! 
    … …  
    660660         eps   (ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin ) 
    661661         hmxl_n(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk) 
    662          ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated)  
     662         ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
    663663         zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
    664664         IF( ln_length_lim )   hmxl_n(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) ) 
    … …  
    720720 
    721721      ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0) 
    722       zstm(:,:,jpk) = 0.   
     722      zstm(:,:,jpk) = 0. 
    723723      DO_2D( 0, 0, 0, 0 )             ! update bottom with good values 
    724724         zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 
    … …  
    756756      !!---------------------------------------------------------------------- 
    757757      !!                  ***  ROUTINE zdf_gls_init  *** 
    758       !!                      
    759       !! ** Purpose :   Initialization of the vertical eddy diffivity and  
     758      !! 
     759      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
    760760      !!              viscosity computed using a GLS turbulent closure scheme 
    761761      !! 
    … …  
    983983         ! 
    984984      END SELECT 
    985      
     985 
    986986      !                                !* Set Schmidt number for psi diffusion in the wave breaking case 
    987987      !                                     ! See Eq. (13) of Carniel et al, OM, 30, 225-239, 2009 
    988988      !                                     !  or Eq. (17) of Burchard, JPO, 31, 3133-3145, 2001 
    989989      IF( ln_sigpsi ) THEN 
    990          ra_sf = -1.5 ! Set kinetic energy slope, then deduce rsc_psi and rl_sf  
     990         ra_sf = -1.5 ! Set kinetic energy slope, then deduce rsc_psi and rl_sf 
    991991         ! Verification: retrieve Burchard (2001) results by uncomenting the line below: 
    992992         ! Note that the results depend on the value of rn_cm_sf which is constant (=rc0) in his work 
    … …  
    996996         rsc_psi0 = rsc_psi 
    997997      ENDIF 
    998   
     998 
    999999      !                                !* Shear free turbulence parameters 
    10001000      ! 
    … …  
    10391039      rc04  = rc03 * rc0 
    10401040      rsbc_tke1 = -3._wp/2._wp*rn_crban*ra_sf*rl_sf                      ! Dirichlet + Wave breaking 
    1041       rsbc_tke2 = rn_Dt * rn_crban / rl_sf                                 ! Neumann + Wave breaking  
     1041      rsbc_tke2 = rn_Dt * rn_crban / rl_sf                                 ! Neumann + Wave breaking 
    10421042      zcr = MAX(rsmall, rsbc_tke1**(1./(-ra_sf*3._wp/2._wp))-1._wp ) 
    1043       rtrans = 0.2_wp / zcr                                              ! Ad. inverse transition length between log and wave layer  
     1043      rtrans = 0.2_wp / zcr                                              ! Ad. inverse transition length between log and wave layer 
    10441044      rsbc_zs1  = rn_charn/grav                                          ! Charnock formula for surface roughness 
    1045       rsbc_zs2  = rn_frac_hs / 0.85_wp / grav * 665._wp                  ! Rascle formula for surface roughness  
     1045      rsbc_zs2  = rn_frac_hs / 0.85_wp / grav * 665._wp                  ! Rascle formula for surface roughness 
    10461046      rsbc_psi1 = -0.5_wp * rn_Dt * rc0**(rpp-2._wp*rmm) / rsc_psi 
    1047       rsbc_psi2 = -0.5_wp * rn_Dt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking  
     1047      rsbc_psi2 = -0.5_wp * rn_Dt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking 
    10481048      ! 
    10491049      rfact_tke = -0.5_wp / rsc_tke * rn_Dt                                ! Cst used for the Diffusion term of tke 
    … …  
    10541054      zwall(:,:,:) = 1._wp * tmask(:,:,:) 
    10551055 
    1056       !                                !* read or initialize all required files   
     1056      !                                !* read or initialize all required files 
    10571057      CALL gls_rst( nit000, 'READ' )      ! (en, avt_k, avm_k, hmxl_n) 
    10581058      ! 
    … …  
    10631063      !!--------------------------------------------------------------------- 
    10641064      !!                   ***  ROUTINE gls_rst  *** 
    1065       !!                      
     1065      !! 
    10661066      !! ** Purpose :   Read or write TKE file (en) in restart file 
    10671067      !! 
    10681068      !! ** Method  :   use of IOM library 
    1069       !!                if the restart does not contain TKE, en is either  
     1069      !!                if the restart does not contain TKE, en is either 
    10701070      !!                set to rn_emin or recomputed (nn_igls/=0) 
    10711071      !!---------------------------------------------------------------------- 
    … …  
    10811081      !!---------------------------------------------------------------------- 
    10821082      ! 
    1083       IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
     1083      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
    10841084         !                                   ! --------------- 
    10851085         IF( ln_rstart ) THEN                   !* Read the restart file 
    … …  
    10941094               CALL iom_get( numror, jpdom_auto, 'avm_k' , avm_k  ) 
    10951095               CALL iom_get( numror, jpdom_auto, 'hmxl_n', hmxl_n ) 
    1096             ELSE                         
     1096            ELSE 
    10971097               IF(lwp) WRITE(numout,*) 
    10981098               IF(lwp) WRITE(numout,*) '   ==>>   previous run without GLS scheme, set en and hmxl_n to background values' 

  • NEMO/trunk/src/OCE/ZDF/zdfosm.F90

    r14045 r14072  
    146146   INTEGER :: idebug = 236 
    147147   INTEGER :: jdebug = 228 
    148     
     148 
    149149   !! * Substitutions 
    150150#  include "do_loop_substitute.h90" 
    … …  
    309309      REAL(wp) :: zl_c,zl_l,zl_eps  ! Used to calculate turbulence length scale. 
    310310 
    311       REAL(wp) :: za_cubic, zb_cubic, zc_cubic, zd_cubic ! coefficients in cubic polynomial specifying diffusivity in pycnocline.   
     311      REAL(wp) :: za_cubic, zb_cubic, zc_cubic, zd_cubic ! coefficients in cubic polynomial specifying diffusivity in pycnocline. 
    312312      REAL(wp), DIMENSION(jpi,jpj) :: zsc_wth_1,zsc_ws_1 ! Temporary scales used to calculate scalar non-gradient terms. 
    313313      REAL(wp), DIMENSION(jpi,jpj) :: zsc_wth_pyc, zsc_ws_pyc ! Scales for pycnocline transport term/ 
    … …  
    665665! 
    666666! 
    667 ! Check to see if lpyc needs to be changed  
     667! Check to see if lpyc needs to be changed 
    668668 
    669669      CALL zdf_osm_pycnocline_thickness( dh, zdh ) 
    670670 
    671671      DO_2D( 0, 0, 0, 0 ) 
    672        IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh .or. ibld(ji,jj) + jp_ext(ji,jj) >= mbkt(ji,jj) .or. ibld(ji,jj)-imld(ji,jj) == 1 ) lpyc(ji,jj) = .FALSE.  
     672       IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh .or. ibld(ji,jj) + jp_ext(ji,jj) >= mbkt(ji,jj) .or. ibld(ji,jj)-imld(ji,jj) == 1 ) lpyc(ji,jj) = .FALSE. 
    673673      END_2D 
    674674 
    … …  
    790790                ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * 0.5 *  zsc_ws_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 
    791791             END DO 
    792               
     792 
    793793             IF ( lpyc(ji,jj) ) THEN 
    794794               ztau_sc_u(ji,jj) = zhml(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 
    795795               ztau_sc_u(ji,jj) = ztau_sc_u(ji,jj) * ( 1.4 -0.4 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) )**1.5 ) 
    796                zwth_ent =  -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zdt_ml(ji,jj)                   
     796               zwth_ent =  -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zdt_ml(ji,jj) 
    797797               zws_ent =  -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zds_ml(ji,jj) 
    798798! Cubic profile used for buoyancy term 
    … …  
    813813               zws_pyc_sc_1 = 0.325 * ( zalpha_pyc(ji,jj) * zds_ml(ji,jj) / zdh(ji,jj) + zdsdz_bl_ext(ji,jj) ) * zdelta_pyc**2 / zdh(ji,jj) 
    814814! 
    815                zzeta_pyc = 0.15 - 0.175 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) )  
     815               zzeta_pyc = 0.15 - 0.175 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) ) 
    816816               DO jk = 2, ibld(ji,jj) 
    817817                 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj) 
    … …  
    820820                 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.05 * zws_pyc_sc_1 * EXP( -0.25 * ( zznd_pyc / zzeta_pyc )**2 ) * zdh(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 
    821821               END DO 
    822             ENDIF ! End of pycnocline                   
     822            ENDIF ! End of pycnocline 
    823823          ELSE ! lconv test - stable conditions 
    824824             DO jk = 2, ibld(ji,jj) 
    … …  
    870870          zd_cubic = zdh(ji,jj) / zhbl(ji,jj) * zuw0(ji,jj) - ( 2.0 + zdh(ji,jj) /zhml(ji,jj) ) * zuw_bse 
    871871          zc_cubic = zuw_bse - zd_cubic 
    872 ! need ztau_sc_u to be available. Change to array.  
     872! need ztau_sc_u to be available. Change to array. 
    873873          DO jk = imld(ji,jj), ibld(ji,jj) 
    874874             zznd_pyc = - ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj) 
    … …  
    892892 
    893893       DO_2D( 1, 0, 1, 0 ) 
    894         
     894 
    895895         IF ( lconv(ji,jj) ) THEN 
    896896           zsc_wth_1(ji,jj) = zwth0(ji,jj) / ( 1.0 - 0.56 * EXP( zhol(ji,jj) ) ) 
    … …  
    926926              DO jk = imld(ji,jj), ibld(ji,jj) 
    927927                zznd_pyc = - ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj) 
    928                 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 4.0 * zsc_wth_pyc(ji,jj) * ( 0.48 - EXP( -1.5 * ( zznd_pyc -0.3)**2 ) )  
    929                 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 4.0 * zsc_ws_pyc(ji,jj) * ( 0.48 - EXP( -1.5 * ( zznd_pyc -0.3)**2 ) )  
     928                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 4.0 * zsc_wth_pyc(ji,jj) * ( 0.48 - EXP( -1.5 * ( zznd_pyc -0.3)**2 ) ) 
     929                ghams(ji,jj,jk) = ghams(ji,jj,jk) + 4.0 * zsc_ws_pyc(ji,jj) * ( 0.48 - EXP( -1.5 * ( zznd_pyc -0.3)**2 ) ) 
    930930              END DO 
    931931           ENDIF 
    … …  
    11361136                 END DO 
    11371137              ELSE 
    1138 ! Surface transports limited to OSBL.                  
     1138! Surface transports limited to OSBL. 
    11391139         ! Viscosity for MLEs 
    11401140                 DO jk = 1, mld_prof(ji,jj) 
    … …  
    12611261     !! ** Purpose : Determines the eddy diffusivity and eddy viscosity profiles in the mixed layer and the pycnocline. 
    12621262     !! 
    1263      !! ** Method  :  
     1263     !! ** Method  : 
    12641264     !! 
    12651265     !! !!---------------------------------------------------------------------- 
    … …  
    12751275! 
    12761276      REAL(wp) :: zvel_sc_pyc, zvel_sc_ml, zstab_fac 
    1277        
     1277 
    12781278      REAL(wp), PARAMETER :: rn_dif_ml = 0.8, rn_vis_ml = 0.375 
    12791279      REAL(wp), PARAMETER :: rn_dif_pyc = 0.15, rn_vis_pyc = 0.142 
    12801280      REAL(wp), PARAMETER :: rn_vispyc_shr = 0.15 
    1281        
     1281 
    12821282      DO_2D( 0, 0, 0, 0 ) 
    12831283          IF ( lconv(ji,jj) ) THEN 
    1284            
     1284 
    12851285            zvel_sc_pyc = ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.25 * zshear(ji,jj) * zhbl(ji,jj) )**pthird 
    12861286            zvel_sc_ml = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    … …  
    12961296                zdifpyc_n_sc(ji,jj) = zdifpyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj) )**pthird * zhbl(ji,jj) 
    12971297              ENDIF 
    1298              
     1298 
    12991299              zdifpyc_s_sc(ji,jj) = zwb_ent(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) 
    13001300              zdifpyc_s_sc(ji,jj) = 0.09 * zdifpyc_s_sc(ji,jj) * zstab_fac 
    13011301              zdifpyc_s_sc(ji,jj) = MAX( zdifpyc_s_sc(ji,jj), -0.5 * zdifpyc_n_sc(ji,jj) ) 
    1302                
     1302 
    13031303              zvispyc_n_sc(ji,jj) = 0.09 * zvel_sc_pyc * ( 1.0 - zhbl(ji,jj) / zdh(ji,jj) )**2 * ( 0.005 * ( zu_ml(ji,jj)-zu_bl(ji,jj) )**2 + 0.0075 * ( zv_ml(ji,jj)-zv_bl(ji,jj) )**2 ) / zdh(ji,jj) 
    13041304              zvispyc_n_sc(ji,jj) = rn_vis_pyc * zvel_sc_ml * zdh(ji,jj) + zvispyc_n_sc(ji,jj) * zstab_fac 
    … …  
    13061306                zvispyc_n_sc(ji,jj) = zvispyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj ) )**pthird * zhbl(ji,jj) 
    13071307              ENDIF 
    1308               
     1308 
    13091309              zvispyc_s_sc(ji,jj) = 0.09 * ( zwb_min(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) ) 
    13101310              zvispyc_s_sc(ji,jj) = zvispyc_s_sc(ji,jj) * zstab_fac 
    … …  
    13831383          ! 
    13841384       END_2D 
    1385         
     1385 
    13861386  END SUBROUTINE zdf_osm_diffusivity_viscosity 
    1387    
     1387 
    13881388  SUBROUTINE zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear, zri_i ) 
    13891389 
    … …  
    13931393     !! ** Purpose : Determines the state of the OSBL, stable/unstable, shear/ noshear. Also determines shear production, entrainment buoyancy flux and interfacial Richardson number 
    13941394     !! 
    1395      !! ** Method  :  
     1395     !! ** Method  : 
    13961396     !! 
    13971397     !! !!---------------------------------------------------------------------- 
    13981398 
    13991399     INTEGER, DIMENSION(jpi,jpj) :: j_ddh  ! j_ddh = 0, active shear layer; j_ddh=1, shear layer not active; j_ddh=2 shear production low. 
    1400       
     1400 
    14011401     LOGICAL, DIMENSION(jpi,jpj) :: lconv, lshear 
    14021402 
    … …  
    14081408 
    14091409     INTEGER :: jj, ji 
    1410       
     1410 
    14111411     REAL(wp), DIMENSION(jpi,jpj) :: zekman 
    14121412     REAL(wp) :: zri_p, zri_b   ! Richardson numbers 
    … …  
    14161416     REAL, PARAMETER :: za_shr = 0.4, zb_shr = 6.5, za_wb_s = 0.1 
    14171417     REAL, PARAMETER :: rn_ri_thres_a = 0.5, rn_ri_thresh_b = 0.59 
    1418      REAL, PARAMETER :: zalpha_c = 0.2, zalpha_lc = 0.04      
     1418     REAL, PARAMETER :: zalpha_c = 0.2, zalpha_lc = 0.04 
    14191419     REAL, PARAMETER :: zalpha_ls = 0.06, zalpha_s = 0.15 
    14201420     REAL, PARAMETER :: rn_ri_p_thresh = 27.0 
    14211421     REAL, PARAMETER :: zrot=0._wp  ! dummy rotation rate of surface stress. 
    1422       
     1422 
    14231423! Determins stability and set flag lconv 
    14241424     DO_2D( 0, 0, 0, 0 ) 
    … …  
    14291429       ENDIF 
    14301430     END_2D 
    1431   
     1431 
    14321432     zekman(:,:) = EXP( - 4.0 * ABS( ff_t(:,:) ) * zhbl(:,:) / MAX(zustar(:,:), 1.e-8 ) ) 
    1433       
     1433 
    14341434     WHERE ( lconv ) 
    14351435       zri_i = zdb_ml * zhml**2 / MAX( ( zvstr**3 + 0.5 * zwstrc**3 )**p2third * zdh, 1.e-12 ) 
    … …  
    14371437 
    14381438     zshear(:,:) = 0._wp 
    1439      j_ddh(:,:) = 1      
    1440   
     1439     j_ddh(:,:) = 1 
     1440 
    14411441     DO_2D( 0, 0, 0, 0 ) 
    14421442      IF ( lconv(ji,jj) ) THEN 
    … …  
    14441444           zri_p = MAX (  SQRT( zdb_bl(ji,jj) * zdh(ji,jj) / MAX( zdu_bl(ji,jj)**2 + zdv_bl(ji,jj)**2, 1.e-8) )  *  ( zhbl(ji,jj) / zdh(ji,jj) ) * ( zvstr(ji,jj) / MAX( zustar(ji,jj), 1.e-6 ) )**2 & 
    14451445                & / MAX( zekman(ji,jj), 1.e-6 )  , 5._wp ) 
    1446           
     1446 
    14471447           zri_b = zdb_ml(ji,jj) * zdh(ji,jj) / MAX( zdu_ml(ji,jj)**2 + zdv_ml(ji,jj)**2, 1.e-8 ) 
    1448                       
     1448 
    14491449           zshear(ji,jj) = za_shr * zekman(ji,jj) * ( MAX( zustar(ji,jj)**2 * zdu_ml(ji,jj) / zhbl(ji,jj), 0._wp ) + zb_shr * MAX( -ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) * zdv_ml(ji,jj) / zhbl(ji,jj), 0._wp ) ) 
    14501450!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    … …  
    14651465               zshear(ji,jj) = 0.5 * zshear(ji,jj) 
    14661466               lshear(ji,jj) = .FALSE. 
    1467              ENDIF  
    1468            ENDIF                 
     1467             ENDIF 
     1468           ENDIF 
    14691469         ELSE                ! zdb_bl test, note zshear set to zero 
    14701470           j_ddh(ji,jj) = 2 
    … …  
    14731473       ENDIF 
    14741474     END_2D 
    1475   
     1475 
    14761476! Calculate entrainment buoyancy flux due to surface fluxes. 
    14771477 
    … …  
    15131513             zshear(ji,jj) = zshear(ji,jj) + zshear_u * ( 1.0 - MIN( zri_p / rn_ri_p_thresh, 1.d0 ) ) 
    15141514             zshear(ji,jj) = MIN( zshear(ji,jj), zshear_u ) 
    1515               
     1515 
    15161516             zwb_shr = -za_wb_s * zshear(ji,jj) 
    1517               
    1518            ENDIF                 
     1517 
     1518           ENDIF 
    15191519           zwb_ent(ji,jj) = zwb_ent(ji,jj) + zwb_shr 
    15201520           zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0(ji,jj) 
    15211521        ELSE    ! IF ( lconv ) THEN - ENDIF 
    1522 ! Stable OSBL  - shear production not coded for first attempt.            
     1522! Stable OSBL  - shear production not coded for first attempt. 
    15231523        ENDIF  ! lconv 
    15241524      ELSE  ! lshear 
    … …  
    15321532     END_2D 
    15331533   END SUBROUTINE zdf_osm_osbl_state 
    1534       
    1535       
     1534 
     1535 
    15361536   SUBROUTINE zdf_osm_vertical_average( jnlev_av, jp_ext, zt, zs, zb, zu, zv, zdt, zds, zdb, zdu, zdv ) 
    15371537     !!--------------------------------------------------------------------- 
    … …  
    16361636     !!  lpyc :: determines whether pycnocline flux-grad relationship needs to be determined 
    16371637     !!  lflux :: determines whether effects of surface flux extend below the base of the OSBL 
    1638      !!  lmle  :: determines whether the layer with MLE is increasing with time or if base is relaxing towards hbl.  
    1639      !! 
    1640      !! ** Method  :  
    1641      !! 
    1642      !!  
     1638     !!  lmle  :: determines whether the layer with MLE is increasing with time or if base is relaxing towards hbl. 
     1639     !! 
     1640     !! ** Method  : 
     1641     !! 
     1642     !! 
    16431643     !!---------------------------------------------------------------------- 
    1644        
     1644 
    16451645! Outputs 
    16461646      LOGICAL,  DIMENSION(jpi,jpj)  :: lpyc, lflux, lmle 
    … …  
    16501650      REAL(wp)                      :: zbuoy, ztmp, zpe_mle_layer 
    16511651      REAL(wp)                      :: zpe_mle_ref, zwb_ent, zdbdz_mle_int 
    1652        
     1652 
    16531653      znd_param(:,:) = 0._wp 
    16541654 
    … …  
    16741674             END DO 
    16751675! Non-dimensional parameter to diagnose the presence of thermocline 
    1676                  
     1676 
    16771677             znd_param(ji,jj) = ( zpe_mle_layer - zpe_mle_ref ) * ABS( ff_t(ji,jj) ) / ( MAX( zwb_fk(ji,jj), 1.0e-10 ) * zhmle(ji,jj) ) 
    16781678           ENDIF 
    … …  
    17171717                  lflux(ji,jj) = .FALSE. 
    17181718                  lmle(ji,jj) = .FALSE. 
    1719                 ENDIF ! zdb_bl < rn_mle_thresh_bl and  
     1719                ENDIF ! zdb_bl < rn_mle_thresh_bl and 
    17201720              ENDIF  ! zhmle > 1.2 zhbl 
    17211721            ELSE 
    … …  
    17241724              lmle(ji,jj) = .FALSE. 
    17251725              IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 
    1726             ENDIF !  -2.0 * zwb_fk(ji,jj) / zwb_ent > 0.5  
     1726            ENDIF !  -2.0 * zwb_fk(ji,jj) / zwb_ent > 0.5 
    17271727          ELSE 
    17281728! Stable Boundary Layer 
    … …  
    19281928    REAL(wp) :: alpha_bc = 0.5 
    19291929    REAL, PARAMETER :: a_ddh = 2.5, a_ddh_2 = 3.5 ! also in pycnocline_depth 
    1930   
     1930 
    19311931  DO_2D( 0, 0, 0, 0 ) 
    1932      
     1932 
    19331933    IF ( lshear(ji,jj) ) THEN 
    19341934       IF ( lconv(ji,jj) ) THEN    ! Convective 
    … …  
    19651965! Relaxation to dh_ref = zari * hbl 
    19661966                     zddhdt(ji,jj) = -a_ddh_2 * ( 1.0 - zdh(ji,jj) / ( zari * zhbl(ji,jj) ) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj) 
    1967                       
     1967 
    19681968                   ELSE  ! j_ddh == 0 
    19691969! Growing shear layer 
    … …  
    21842184             dh(ji,jj) = dh(ji,jj) + zddhdt(ji,jj) * rn_Dt 
    21852185           ELSE 
    2186 ! Temporary (probably) Recalculate dh_ref to ensure dh doesn't go negative. Can't do this using zddhdt from calculate_dhdt  
     2186! Temporary (probably) Recalculate dh_ref to ensure dh doesn't go negative. Can't do this using zddhdt from calculate_dhdt 
    21872187             IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 
    21882188               zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 
    … …  
    21942194             IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zari * zhbl(ji,jj) 
    21952195           ENDIF 
    2196              
     2196 
    21972197         ELSE ! lconv 
    2198 ! Initially shear only for entraining OSBL. Stable code will be needed if extended to stable OSBL  
     2198! Initially shear only for entraining OSBL. Stable code will be needed if extended to stable OSBL 
    21992199 
    22002200            ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 
    … …  
    22162216            ! Alan: this hml is never defined or used -- do we need it? 
    22172217         ENDIF 
    2218            
    2219       ELSE   ! lshear   
     2218 
     2219      ELSE   ! lshear 
    22202220! for lshear = .FALSE. calculate ddhdt here 
    22212221 
    … …  
    22802280         ENDIF       ! IF (lconv) 
    22812281      ENDIF  ! lshear 
    2282   
     2282 
    22832283      hml(ji,jj) = hbl(ji,jj) - dh(ji,jj) 
    22842284      inhml = MAX( INT( dh(ji,jj) / MAX(e3t(ji,jj,ibld(ji,jj),Kmm), 1.e-3) ) , 1 ) 
    … …  
    23782378             & + dbdx_mle(ji-1,jj) * dbdx_mle(ji-1,jj) + dbdy_mle(ji,jj-1) * dbdy_mle(ji,jj-1) ) ) 
    23792379      END_2D 
    2380        
     2380 
    23812381 END SUBROUTINE zdf_osm_zmld_horizontal_gradients 
    23822382  SUBROUTINE zdf_osm_mle_parameters( mld_prof, hmle, zhmle, zvel_mle, zdiff_mle ) 
    … …  
    24162416           jkb = mld_prof(ji,jj) 
    24172417           jkb1 = MIN(jkb + 1, mbkt(ji,jj)) 
    2418 !               
     2418! 
    24192419           zbuoy = grav * ( zthermal * ts(ji,jj,mld_prof(ji,jj)+2,jp_tem,Kmm) - zbeta * ts(ji,jj,mld_prof(ji,jj)+2,jp_sal,Kmm) ) 
    2420            zdb_mle = zb_bl(ji,jj) - zbuoy  
    2421 ! Timestep hmle.  
     2420           zdb_mle = zb_bl(ji,jj) - zbuoy 
     2421! Timestep hmle. 
    24222422           hmle(ji,jj) = hmle(ji,jj) + zwb0(ji,jj) * rn_Dt / zdb_mle 
    24232423        ELSE 

  • NEMO/trunk/src/OCE/ZDF/zdfphy.F90

    r14045 r14072  
    99   !!---------------------------------------------------------------------- 
    1010   !!   zdf_phy_init  : initialization of all vertical physics packages 
    11    !!   zdf_phy       : upadate at each time-step the vertical mixing coeff.  
     11   !!   zdf_phy       : upadate at each time-step the vertical mixing coeff. 
    1212   !!---------------------------------------------------------------------- 
    1313   USE oce            ! ocean dynamics and tracers variables 
    14    USE zdf_oce        ! vertical physics: shared variables          
     14   USE zdf_oce        ! vertical physics: shared variables 
    1515   USE zdfdrg         ! vertical physics: top/bottom drag coef. 
    1616   USE zdfsh2         ! vertical physics: shear production term of TKE 
    17    USE zdfric         ! vertical physics: RIChardson dependent vertical mixing    
     17   USE zdfric         ! vertical physics: RIChardson dependent vertical mixing 
    1818   USE zdftke         ! vertical physics: TKE vertical mixing 
    1919   USE zdfgls         ! vertical physics: GLS vertical mixing 
    2020   USE zdfosm         ! vertical physics: OSMOSIS vertical mixing 
    21    USE zdfddm         ! vertical physics: double diffusion mixing       
    22    USE zdfevd         ! vertical physics: convection via enhanced vertical diffusion   
    23    USE zdfmfc         ! vertical physics: Mass Flux Convection  
    24    USE zdfiwm         ! vertical physics: internal wave-induced mixing   
     21   USE zdfddm         ! vertical physics: double diffusion mixing 
     22   USE zdfevd         ! vertical physics: convection via enhanced vertical diffusion 
     23   USE zdfmfc         ! vertical physics: Mass Flux Convection 
     24   USE zdfiwm         ! vertical physics: internal wave-induced mixing 
    2525   USE zdfswm         ! vertical physics: surface  wave-induced mixing 
    2626   USE zdfmxl         ! vertical physics: mixed layer 
    2727   USE tranpc         ! convection: non penetrative adjustment 
    28    USE trc_oce        ! variables shared between passive tracer & ocean            
     28   USE trc_oce        ! variables shared between passive tracer & ocean 
    2929   USE sbc_oce        ! surface module (only for nn_isf in the option compatibility test) 
    3030   USE sbcrnf         ! surface boundary condition: runoff variables 
    … …  
    4646   PUBLIC   zdf_phy       ! called by step.F90 
    4747 
    48    INTEGER ::   nzdf_phy   ! type of vertical closure used  
     48   INTEGER ::   nzdf_phy   ! type of vertical closure used 
    4949   !                       ! associated indicators 
    5050   INTEGER, PARAMETER ::   np_CST = 1   ! Constant Kz 
    … …  
    6666      !!---------------------------------------------------------------------- 
    6767      !!                  ***  ROUTINE zdf_phy_init  *** 
    68       !!  
     68      !! 
    6969      !! ** Purpose :   initializations of the vertical ocean physics 
    7070      !! 
    71       !! ** Method  :   Read namelist namzdf, control logicals  
     71      !! ** Method  :   Read namelist namzdf, control logicals 
    7272      !!                set horizontal shape and vertical profile of background mixing coef. 
    7373      !!---------------------------------------------------------------------- 
    … …  
    143143      IF( nn_avb == 0 ) THEN             ! Define avmb, avtb from namelist parameter 
    144144         avmb(:) = rn_avm0 
    145          avtb(:) = rn_avt0                      
     145         avtb(:) = rn_avt0 
    146146      ELSE                               ! Background profile of avt (fit a theoretical/observational profile (Krauss 1990) 
    147147         avmb(:) = rn_avm0 
    … …  
    150150      ENDIF 
    151151      !                                  ! 2D shape of the avtb 
    152       avtb_2d(:,:) = 1._wp                   ! uniform  
     152      avtb_2d(:,:) = 1._wp                   ! uniform 
    153153      ! 
    154154      IF( nn_havtb == 1 ) THEN               ! decrease avtb by a factor of ten in the equatorial band 
    … …  
    198198 
    199199      !                          !==  type of vertical turbulent closure  ==!    (set nzdf_phy) 
    200       ioptio = 0  
     200      ioptio = 0 
    201201      IF( ln_zdfcst ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_CST   ;   ENDIF 
    202202      IF( ln_zdfric ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_RIC   ;   CALL zdf_ric_init          ;   ENDIF 
    … …  
    236236      !! ** Purpose :  Update ocean physics at each time-step 
    237237      !! 
    238       !! ** Method  :  
     238      !! ** Method  : 
    239239      !! 
    240240      !! ** Action  :   avm, avt vertical eddy viscosity and diffusivity at w-points 
    … …  
    254254         ! 
    255255         !                       !* bottom drag 
    256          CALL zdf_drg( kt, Kmm, mbkt , r_Cdmin_bot, r_Cdmax_bot,   &   ! <<== in  
     256         CALL zdf_drg( kt, Kmm, mbkt , r_Cdmin_bot, r_Cdmax_bot,   &   ! <<== in 
    257257            &              r_z0_bot,   r_ke0_bot,    rCd0_bot,   & 
    258258            &                                        rCdU_bot  )     ! ==>> out : bottom drag [m/s] 
    259259         IF( ln_isfcav ) THEN    !* top drag   (ocean cavities) 
    260             CALL zdf_drg( kt, Kmm, mikt , r_Cdmin_top, r_Cdmax_top,   &   ! <<== in  
     260            CALL zdf_drg( kt, Kmm, mikt , r_Cdmin_top, r_Cdmax_top,   &   ! <<== in 
    261261               &              r_z0_top,   r_ke0_top,    rCd0_top,   & 
    262262               &                                        rCdU_top  )     ! ==>> out : bottom drag [m/s] 
    … …  
    273273      ENDIF 
    274274#endif 
    275       !  
     275      ! 
    276276      !                       !==  Kz from chosen turbulent closure  ==!   (avm_k, avt_k) 
    277277      ! 
    … …  
    290290!!gm         avm(2:jpim1,2:jpjm1,1:jpkm1) = rn_avm0 * wmask(2:jpim1,2:jpjm1,1:jpkm1) 
    291291      END SELECT 
    292       !   
     292      ! 
    293293      !                          !==  ocean Kz  ==!   (avt, avs, avm) 
    294294      ! 
    … …  
    312312      ENDIF 
    313313      ! 
    314       !                                         !* wave-induced mixing  
    315       IF( ln_zdfswm )   CALL zdf_swm( kt, Kmm, avm, avt, avs )   ! surface  wave (Qiao et al. 2004)  
     314      !                                         !* wave-induced mixing 
     315      IF( ln_zdfswm )   CALL zdf_swm( kt, Kmm, avm, avt, avs )   ! surface  wave (Qiao et al. 2004) 
    316316      IF( ln_zdfiwm )   CALL zdf_iwm( kt, Kmm, avm, avt, avs )   ! internal wave (de Lavergne et al 2017) 
    317317 
    318 #if defined key_agrif  
     318#if defined key_agrif 
    319319      ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2) 
    320320      IF( l_zdfsh2 )   CALL Agrif_avm 
    … …  
    340340         IF( ln_zdftke )   CALL tke_rst( kt, 'WRITE' ) 
    341341         IF( ln_zdfgls )   CALL gls_rst( kt, 'WRITE' ) 
    342          IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' )  
     342         IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' ) 
    343343         ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated 
    344344      ENDIF 

  • NEMO/trunk/src/OCE/ZDF/zdfric.F90

    r13970 r14072  
    1212   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    1313   !!            3.3.1!  2011-09  (P. Oddo) Mixed layer depth parameterization 
    14    !!            4.0  !  2017-04  (G. Madec)  remove CPP ddm key & avm at t-point only  
     14   !!            4.0  !  2017-04  (G. Madec)  remove CPP ddm key & avm at t-point only 
    1515   !!---------------------------------------------------------------------- 
    1616 
    … …  
    2828   USE in_out_manager ! I/O manager 
    2929   USE iom            ! I/O manager library 
    30    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     30   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3131 
    3232 
    … …  
    4343   REAL(wp) ::   rn_alp      ! coefficient of the parameterization 
    4444   REAL(wp) ::   rn_ekmfc    ! Ekman Factor Coeff 
    45    REAL(wp) ::   rn_mldmin   ! minimum mixed layer (ML) depth     
     45   REAL(wp) ::   rn_mldmin   ! minimum mixed layer (ML) depth 
    4646   REAL(wp) ::   rn_mldmax   ! maximum mixed layer depth 
    4747   REAL(wp) ::   rn_wtmix    ! Vertical eddy Diff. in the ML 
    … …  
    6161      !!---------------------------------------------------------------------- 
    6262      !!                 ***  ROUTINE zdf_ric_init  *** 
    63       !!                     
     63      !! 
    6464      !! ** Purpose :   Initialization of the vertical eddy diffusivity and 
    6565      !!      viscosity coef. for the Richardson number dependent formulation. 
    … …  
    109109      !!---------------------------------------------------------------------- 
    110110      !!                 ***  ROUTINE zdfric  *** 
    111       !!                     
     111      !! 
    112112      !! ** Purpose :   Compute the before eddy viscosity and diffusivity as 
    113113      !!                a function of the local richardson number. 
    114114      !! 
    115       !! ** Method  :   Local richardson number dependent formulation of the  
    116       !!                vertical eddy viscosity and diffusivity coefficients.  
     115      !! ** Method  :   Local richardson number dependent formulation of the 
     116      !!                vertical eddy viscosity and diffusivity coefficients. 
    117117      !!                The eddy coefficients are given by: 
    118118      !!                    avm = avm0 + avmb 
    … …  
    122122      !!                    avm0= rn_avmri / (1 + rn_alp*Ri)**nn_ric 
    123123      !!                where ri is the before local Richardson number, 
    124       !!                rn_avmri is the maximum value reaches by avm and avt  
     124      !!                rn_avmri is the maximum value reaches by avm and avt 
    125125      !!                and rn_alp, nn_ric are adjustable parameters. 
    126126      !!                Typical values : rn_alp=5. and nn_ric=2. 
    … …  
    164164      END_3D 
    165165      ! 
    166 !!gm BUG <<<<====  This param can't work at low latitude  
     166!!gm BUG <<<<====  This param can't work at low latitude 
    167167!!gm               it provides there much to thick mixed layer ( summer 150m in GYRE configuration !!! ) 
    168168      ! 
    … …  
    188188      !!--------------------------------------------------------------------- 
    189189      !!                   ***  ROUTINE ric_rst  *** 
    190       !!                      
     190      !! 
    191191      !! ** Purpose :   Read or write TKE file (en) in restart file 
    192192      !! 
    193193      !! ** Method  :   use of IOM library 
    194       !!                if the restart does not contain TKE, en is either  
    195       !!                set to rn_emin or recomputed  
     194      !!                if the restart does not contain TKE, en is either 
     195      !!                set to rn_emin or recomputed 
    196196      !!---------------------------------------------------------------------- 
    197197      INTEGER         , INTENT(in) ::   kt     ! ocean time-step 
    … …  
    202202      !!---------------------------------------------------------------------- 
    203203      ! 
    204       IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
     204      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
    205205         !                                   ! --------------- 
    206206         !           !* Read the restart file 

  • NEMO/trunk/src/OCE/ZDF/zdfsh2.F90

    r14007 r14072  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  zdfsh2  *** 
    4    !! Ocean physics:  shear production term of TKE  
     4   !! Ocean physics:  shear production term of TKE 
    55   !!===================================================================== 
    66   !! History :   -   !  2014-10  (A. Barthelemy, G. Madec)  original code 
    … …  
    3636CONTAINS 
    3737 
    38    SUBROUTINE zdf_sh2( Kbb, Kmm, p_avm, p_sh2  )  
     38   SUBROUTINE zdf_sh2( Kbb, Kmm, p_avm, p_sh2  ) 
    3939      !!---------------------------------------------------------------------- 
    4040      !!                   ***  ROUTINE zdf_sh2  *** 
    … …  
    4444      !! ** Method  : - a stable discretization of this term is linked to the 
    4545      !!                time-space discretization of the vertical diffusion 
    46       !!                of the OGCM. NEMO uses C-grid, a leap-frog environment  
     46      !!                of the OGCM. NEMO uses C-grid, a leap-frog environment 
    4747      !!                and an implicit computation of vertical mixing term, 
    4848      !!                so the shear production at w-point is given by: 
    49       !!                   sh2 = mi[   mi(avm) * dk[ub]/e3ub * dk[un]/e3un   ]  
    50       !!                       + mj[   mj(avm) * dk[vb]/e3vb * dk[vn]/e3vn   ]  
     49      !!                   sh2 = mi[   mi(avm) * dk[ub]/e3ub * dk[un]/e3un   ] 
     50      !!                       + mj[   mj(avm) * dk[vb]/e3vb * dk[vn]/e3vn   ] 
    5151      !!                NB: wet-point only horizontal averaging of shear 
    5252      !! 
    … …  
    8181               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 
    8282                  &         * (   uu(ji,jj,jk-1,Kmm) -   uu(ji,jj,jk,Kmm) ) & 
    83                   &         * (   uu(ji,jj,jk-1,Kbb) -   uu(ji,jj,jk,Kbb) ) &  
     83                  &         * (   uu(ji,jj,jk-1,Kbb) -   uu(ji,jj,jk,Kbb) ) & 
    8484                  &         / ( e3uw(ji,jj,jk  ,Kmm) * e3uw(ji,jj,jk,Kbb) ) & 
    8585                  &         * wumask(ji,jj,jk) 

  • NEMO/trunk/src/OCE/ZDF/zdftke.F90

    r14057 r14072  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  zdftke  *** 
    4    !! Ocean physics:  vertical mixing coefficient computed from the tke  
     4   !! Ocean physics:  vertical mixing coefficient computed from the tke 
    55   !!                 turbulent closure parameterization 
    66   !!===================================================================== 
    … …  
    2222   !!             -   !  2008-05  (J.-M. Molines, G. Madec)  2D form of avtb 
    2323   !!             -   !  2008-06  (G. Madec)  style + DOCTOR name for namelist parameters 
    24    !!             -   !  2008-12  (G. Reffray) stable discretization of the production term  
    25    !!            3.2  !  2009-06  (G. Madec, S. Masson) TKE restart compatible with key_cpl  
     24   !!             -   !  2008-12  (G. Reffray) stable discretization of the production term 
     25   !!            3.2  !  2009-06  (G. Madec, S. Masson) TKE restart compatible with key_cpl 
    2626   !!                 !                                + cleaning of the parameters + bugs correction 
    2727   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    2828   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    29    !!            4.0  !  2017-04  (G. Madec)  remove CPP ddm key & avm at t-point only  
     29   !!            4.0  !  2017-04  (G. Madec)  remove CPP ddm key & avm at t-point only 
    3030   !!             -   !  2017-05  (G. Madec)  add top/bottom friction as boundary condition 
    3131   !!            4.2  !  2020-12  (G. Madec, E. Clementi) add wave coupling 
    … …  
    5959   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    6060   USE prtctl         ! Print control 
    61    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     61   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    6262   USE sbcwave        ! Surface boundary waves 
    6363 
    … …  
    7878   INTEGER  ::   nn_pdl    ! Prandtl number or not (ratio avt/avm) (=0/1) 
    7979   REAL(wp) ::   rn_ediff  ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e) 
    80    REAL(wp) ::   rn_ediss  ! coefficient of the Kolmogoroff dissipation  
     80   REAL(wp) ::   rn_ediss  ! coefficient of the Kolmogoroff dissipation 
    8181   REAL(wp) ::   rn_ebb    ! coefficient of the surface input of tke 
    8282   REAL(wp) ::   rn_emin   ! minimum value of tke           [m2/s2] 
    … …  
    9090   LOGICAL  ::   ln_lc     ! Langmuir cells (LC) as a source term of TKE or not 
    9191   REAL(wp) ::      rn_lc     ! coef to compute vertical velocity of Langmuir cells 
    92    INTEGER  ::   nn_eice   ! attenutaion of langmuir & surface wave breaking under ice (=0/1/2/3)    
     92   INTEGER  ::   nn_eice   ! attenutaion of langmuir & surface wave breaking under ice (=0/1/2/3) 
    9393 
    9494   REAL(wp) ::   ri_cri    ! critic Richardson number (deduced from rn_ediff and rn_ediss values) 
    … …  
    139139      !!         surface: en = max( rn_emin0, rn_ebb * taum ) 
    140140      !!         bottom : en = rn_emin 
    141       !!      The associated critical Richardson number is: ri_cri = 2/(2+rn_ediss/rn_ediff)  
    142       !! 
    143       !!        The now Turbulent kinetic energy is computed using the following  
     141      !!      The associated critical Richardson number is: ri_cri = 2/(2+rn_ediss/rn_ediff) 
     142      !! 
     143      !!        The now Turbulent kinetic energy is computed using the following 
    144144      !!      time stepping: implicit for vertical diffusion term, linearized semi 
    145       !!      implicit for kolmogoroff dissipation term, and explicit forward for  
    146       !!      both buoyancy and shear production terms. Therefore a tridiagonal  
     145      !!      implicit for kolmogoroff dissipation term, and explicit forward for 
     146      !!      both buoyancy and shear production terms. Therefore a tridiagonal 
    147147      !!      linear system is solved. Note that buoyancy and shear terms are 
    148148      !!      discretized in a energy conserving form (Bruchard 2002). 
    … …  
    152152      !! 
    153153      !!        The now vertical eddy vicosity and diffusivity coefficients are 
    154       !!      given by:  
     154      !!      given by: 
    155155      !!              avm = max( avtb, rn_ediff * zmxlm * en^1/2 ) 
    156       !!              avt = max( avmb, pdl * avm                 )   
     156      !!              avt = max( avmb, pdl * avm                 ) 
    157157      !!              eav = max( avmb, avm ) 
    158158      !!      where pdl, the inverse of the Prandtl number is 1 if nn_pdl=0 and 
    159       !!      given by an empirical funtion of the localRichardson number if nn_pdl=1  
     159      !!      given by an empirical funtion of the localRichardson number if nn_pdl=1 
    160160      !! 
    161161      !! ** Action  :   compute en (now turbulent kinetic energy) 
    … …  
    193193      !!                a tridiagonal linear system by a "methode de chasse" 
    194194      !!              - increase TKE due to surface and internal wave breaking 
    195       !!             NB: when sea-ice is present, both LC parameterization  
    196       !!                 and TKE penetration are turned off when the ice fraction  
    197       !!                 is smaller than 0.25  
     195      !!             NB: when sea-ice is present, both LC parameterization 
     196      !!                 and TKE penetration are turned off when the ice fraction 
     197      !!                 is smaller than 0.25 
    198198      !! 
    199199      !! ** Action  : - en : now turbulent kinetic energy) 
    … …  
    223223      zbbrau  = rn_ebb / rho0       ! Local constant initialisation 
    224224      zbbirau = 3.75_wp / rho0 
    225       zfact1  = -.5_wp * rn_Dt  
     225      zfact1  = -.5_wp * rn_Dt 
    226226      zfact2  = 1.5_wp * rn_Dt * rn_ediss 
    227227      zfact3  = 0.5_wp         * rn_ediss 
    … …  
    244244         en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) 
    245245         zdiag(ji,jj,1) = 1._wp/en(ji,jj,1) 
    246          zd_lw(ji,jj,1) = 1._wp   
     246         zd_lw(ji,jj,1) = 1._wp 
    247247         zd_up(ji,jj,1) = 0._wp 
    248248      END_2D 
    … …  
    345345         END_2D 
    346346         DO_3D( 0, 0, 0, 0, 2, jpkm1 )                  !* TKE Langmuir circulation source term added to en 
    347             IF ( zus3(ji,jj) /= 0._wp ) THEN                
     347            IF ( zus3(ji,jj) /= 0._wp ) THEN 
    348348               IF ( gdepw(ji,jj,jk,Kmm) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 
    349349                  !                                           ! vertical velocity due to LC 
    … …  
    376376         END_3D 
    377377      ENDIF 
    378       !          
     378      ! 
    379379      DO_3D( 0, 0, 0, 0, 2, jpkm1 )   !* Matrix and right hand side in en 
    380380         zcof   = zfact1 * tmask(ji,jj,jk) 
    … …  
    403403      ! 
    404404      IF ( cpl_phioc .and. ln_phioc )  THEN 
    405          SELECT CASE (nn_bc_surf) ! Boundary Condition using surface TKE flux from waves  
     405         SELECT CASE (nn_bc_surf) ! Boundary Condition using surface TKE flux from waves 
    406406 
    407407         CASE ( 0 ) ! Dirichlet BC 
    … …  
    456456      ! 
    457457      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
    458          DO_3D( 0, 0, 0, 0, 2, jpkm1 )  
     458         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    459459            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   & 
    460460               &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    … …  
    470470            ztx2 = utau(ji-1,jj  ) + utau(ji,jj) 
    471471            zty2 = vtau(ji  ,jj-1) + vtau(ji,jj) 
    472             ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)    ! module of the mean stress  
    473             zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean  
     472            ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)    ! module of the mean stress 
     473            zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean 
    474474            zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
    475475            en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   & 
    … …  
    487487      !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity 
    488488      !! 
    489       !! ** Method  :   At this stage, en, the now TKE, is known (computed in  
    490       !!              the tke_tke routine). First, the now mixing lenth is  
     489      !! ** Method  :   At this stage, en, the now TKE, is known (computed in 
     490      !!              the tke_tke routine). First, the now mixing lenth is 
    491491      !!      computed from en and the strafification (N^2), then the mixings 
    492492      !!      coefficients are computed. 
    493493      !!              - Mixing length : a first evaluation of the mixing lengh 
    494494      !!      scales is: 
    495       !!                      mxl = sqrt(2*en) / N   
     495      !!                      mxl = sqrt(2*en) / N 
    496496      !!      where N is the brunt-vaisala frequency, with a minimum value set 
    497497      !!      to rmxl_min (rn_mxl0) in the interior (surface) ocean. 
    498       !!        The mixing and dissipative length scale are bound as follow :  
     498      !!        The mixing and dissipative length scale are bound as follow : 
    499499      !!         nn_mxl=0 : mxl bounded by the distance to surface and bottom. 
    500500      !!                        zmxld = zmxlm = mxl 
    501501      !!         nn_mxl=1 : mxl bounded by the e3w and zmxld = zmxlm = mxl 
    502       !!         nn_mxl=2 : mxl bounded such that the vertical derivative of mxl is  
     502      !!         nn_mxl=2 : mxl bounded such that the vertical derivative of mxl is 
    503503      !!                    less than 1 (|d/dz(mxl)|<1) and zmxld = zmxlm = mxl 
    504504      !!         nn_mxl=3 : mxl is bounded from the surface to the bottom usings 
    505       !!                    |d/dz(xml)|<1 to obtain lup, and from the bottom to  
    506       !!                    the surface to obtain ldown. the resulting length  
     505      !!                    |d/dz(xml)|<1 to obtain lup, and from the bottom to 
     506      !!                    the surface to obtain ldown. the resulting length 
    507507      !!                    scales are: 
    508       !!                        zmxld = sqrt( lup * ldown )  
     508      !!                        zmxld = sqrt( lup * ldown ) 
    509509      !!                        zmxlm = min ( lup , ldown ) 
    510510      !!              - Vertical eddy viscosity and diffusivity: 
    511511      !!                      avm = max( avtb, rn_ediff * zmxlm * en^1/2 ) 
    512       !!                      avt = max( avmb, pdlr * avm )   
     512      !!                      avt = max( avmb, pdlr * avm ) 
    513513      !!      with pdlr=1 if nn_pdl=0, pdlr=1/pdl=F(Ri) otherwise. 
    514514      !! 
    … …  
    534534      ! 
    535535      ! initialisation of interior minimum value (avoid a 2d loop with mikt) 
    536       zmxlm(:,:,:)  = rmxl_min     
     536      zmxlm(:,:,:)  = rmxl_min 
    537537      zmxld(:,:,:)  = rmxl_min 
    538538      ! 
    … …  
    543543         zmxlm(:,:,1)= zcoef * MAX ( 1.6 * hsw(:,:) , 0.02 )        ! surface mixing length = F(wave height) 
    544544      ELSE 
    545       !  
     545      ! 
    546546         IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 
    547547         ! 
    … …  
    603603      !                     !* Physical limits for the mixing length 
    604604      ! 
    605       zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the minimum value  
     605      zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the minimum value 
    606606      zmxld(:,:,jpk) = rmxl_min       ! last level  set to the minimum value 
    607607      ! 
    … …  
    686686      !!---------------------------------------------------------------------- 
    687687      !!                  ***  ROUTINE zdf_tke_init  *** 
    688       !!                      
    689       !! ** Purpose :   Initialization of the vertical eddy diffivity and  
     688      !! 
     689      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
    690690      !!              viscosity when using a tke turbulent closure scheme 
    691691      !! 
    … …  
    707707         &                 rn_mxl0 , nn_mxlice, rn_mxlice,             & 
    708708         &                 nn_pdl  , ln_lc    , rn_lc    ,             & 
    709          &                 nn_etau , nn_htau  , rn_efr   , nn_eice  ,  &    
     709         &                 nn_etau , nn_htau  , rn_efr   , nn_eice  ,  & 
    710710         &                 nn_bc_surf, nn_bc_bot, ln_mxhsw 
    711711      !!---------------------------------------------------------------------- 
    … …  
    760760         WRITE(numout,*) '          fraction of TKE that penetrates            rn_efr    = ', rn_efr 
    761761         WRITE(numout,*) '      langmuir & surface wave breaking under ice  nn_eice = ', nn_eice 
    762          SELECT CASE( nn_eice )  
     762         SELECT CASE( nn_eice ) 
    763763         CASE( 0 )   ;   WRITE(numout,*) '   ==>>>   no impact of ice cover on langmuir & surface wave breaking' 
    764764         CASE( 1 )   ;   WRITE(numout,*) '   ==>>>   weigthed by 1-TANH( fr_i(:,:) * 10 )' 
    … …  
    767767         CASE DEFAULT 
    768768            CALL ctl_stop( 'zdf_tke_init: wrong value for nn_eice, should be 0,1,2, or 3') 
    769          END SELECT       
     769         END SELECT 
    770770         WRITE(numout,*) 
    771771         WRITE(numout,*) '   ==>>>   critical Richardson nb with your parameters  ri_cri = ', ri_cri 
    … …  
    796796         rn_mxl0 = rmxl_min 
    797797      ENDIF 
    798        
    799       IF( nn_etau == 2  )   CALL zdf_mxl( nit000, Kmm )      ! Initialization of nmln  
     798 
     799      IF( nn_etau == 2  )   CALL zdf_mxl( nit000, Kmm )      ! Initialization of nmln 
    800800 
    801801      !                               !* depth of penetration of surface tke 
    802       IF( nn_etau /= 0 ) THEN       
     802      IF( nn_etau /= 0 ) THEN 
    803803         SELECT CASE( nn_htau )             ! Choice of the depth of penetration 
    804804         CASE( 0 )                                 ! constant depth penetration (here 10 meters) 
    805805            htau(:,:) = 10._wp 
    806806         CASE( 1 )                                 ! F(latitude) : 0.5m to 30m poleward of 40 degrees 
    807             htau(:,:) = MAX(  0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(:,:) ) ) )   )             
     807            htau(:,:) = MAX(  0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(:,:) ) ) )   ) 
    808808         END SELECT 
    809809      ENDIF 
    810810      !                                !* read or initialize all required files 
    811       CALL tke_rst( nit000, 'READ' )      ! (en, avt_k, avm_k, dissl)  
     811      CALL tke_rst( nit000, 'READ' )      ! (en, avt_k, avm_k, dissl) 
    812812      ! 
    813813   END SUBROUTINE zdf_tke_init 
    … …  
    817817      !!--------------------------------------------------------------------- 
    818818      !!                   ***  ROUTINE tke_rst  *** 
    819       !!                      
     819      !! 
    820820      !! ** Purpose :   Read or write TKE file (en) in restart file 
    821821      !! 
    822822      !! ** Method  :   use of IOM library 
    823       !!                if the restart does not contain TKE, en is either  
    824       !!                set to rn_emin or recomputed  
     823      !!                if the restart does not contain TKE, en is either 
     824      !!                set to rn_emin or recomputed 
    825825      !!---------------------------------------------------------------------- 
    826826      USE zdf_oce , ONLY : en, avt_k, avm_k   ! ocean vertical physics 
    … …  
    833833      !!---------------------------------------------------------------------- 
    834834      ! 
    835       IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
     835      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
    836836         !                                   ! --------------- 
    837837         IF( ln_rstart ) THEN                   !* Read the restart file 

  • NEMO/trunk/src/OCE/do_loop_substitute.h90

    r13982 r14072  
    1414!   DO jj = ....                           DO jj = ... 
    1515!      DO ji = ....                           DO ji = ... 
    16 !         .                   OR                 .   
     16!         .                   OR                 . 
    1717!         .                                      . 
    1818!     END DO                                  END DO 
    … …  
    2525! Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj) 
    2626! 
    27 ! The macro naming convention takes the form: DO_2D( B, T, L, R) where:  
     27! The macro naming convention takes the form: DO_2D( B, T, L, R) where: 
    2828!   B is the Bottom offset from the PE's inner domain; 
    2929!   T is the Top    offset from the PE's inner domain; 
    … …  
    3232! 
    3333! So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace: 
    34 !  
     34! 
    3535!   DO jj = 2, jpj 
    3636!      DO ji = 1, jpim1 
    … …  
    4646!      . 
    4747!   END_2D 
    48 !  
    49 ! similar conventions apply to the 3D loops macros. jk loop limits are retained through macro arguments  
    50 ! and are not restricted. This includes the possibility of strides for which an extra set of DO_3DS  
     48! 
     49! similar conventions apply to the 3D loops macros. jk loop limits are retained through macro arguments 
     50! and are not restricted. This includes the possibility of strides for which an extra set of DO_3DS 
    5151! macros are defined. 
    5252! 
    53 ! In the following definitions the inner PE domain is defined by start indices of (Nis0, Njs0) and end  
     53! In the following definitions the inner PE domain is defined by start indices of (Nis0, Njs0) and end 
    5454! indices of (Nie0, Nje0) where: 
    5555! 
    5656! Nis0 =   1 + nn_hls     Njs0 =   1 + nn_hls 
    5757! Nie0 = jpi - nn_hls     Nje0 = jpj - nn_hls 
    58 !  
     58! 
    5959#endif 
    6060 

  • NEMO/trunk/src/OCE/nemogcm.F90

    r14053 r14072  
    2929   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    3030   !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE 
    31    !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
     31   !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
    3232   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla) 
    3333   !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
    … …  
    7474   USE lib_mpp        ! distributed memory computing 
    7575   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    76    USE lbcnfd  , ONLY : isendto, nsndto  ! Setup of north fold exchanges  
     76   USE lbcnfd  , ONLY : isendto, nsndto  ! Setup of north fold exchanges 
    7777   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    7878   USE halo_mng       ! Halo manager 
    … …  
    184184            CALL stp_MLF      ( istp ) 
    185185#  else 
    186             CALL stp        ( istp )  
     186            CALL stp        ( istp ) 
    187187#  endif 
    188188            istp = istp + 1 
    … …  
    195195         ! 
    196196         DO WHILE( istp <= nitend .AND. nstop == 0 ) 
    197             CALL stp_diurnal( istp )   ! time step only the diurnal SST  
     197            CALL stp_diurnal( istp )   ! time step only the diurnal SST 
    198198            istp = istp + 1 
    199199         END DO 
    … …  
    308308#ifdef key_agrif 
    309309      ELSE 
    310                   numnul = Agrif_Parent(numnul)    
     310                  numnul = Agrif_Parent(numnul) 
    311311#endif 
    312312      ENDIF 
    … …  
    373373903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 
    374374      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    375 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )    
     375904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 
    376376      ! 
    377377      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    … …  
    396396#if defined key_agrif 
    397397      Kbb_a = Nbb   ;   Kmm_a = Nnn   ;   Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    398 #endif  
     398#endif 
    399399      !                             !-------------------------------! 
    400400      !                             !  NEMO general initialization  ! 
    … …  
    416416#endif 
    417417                           CALL     dom_init( Nbb, Nnn, Naa )   ! Domain 
    418       IF( ln_crs       )   CALL     crs_init(      Nnn      )   ! coarsened grid: domain initialization  
     418      IF( ln_crs       )   CALL     crs_init(      Nnn      )   ! coarsened grid: domain initialization 
    419419      IF( sn_cfctl%l_prtctl )   & 
    420420         &                 CALL prt_ctl_init        ! Print control 
    421        
     421 
    422422                           CALL diurnal_sst_bulk_init       ! diurnal sst 
    423       IF( ln_diurnal   )   CALL diurnal_sst_coolskin_init   ! cool skin    
    424       !                             
     423      IF( ln_diurnal   )   CALL diurnal_sst_coolskin_init   ! cool skin 
     424      ! 
    425425      IF( ln_diurnal_only ) THEN                    ! diurnal only: a subset of the initialisation routines 
    426426         CALL  istate_init( Nbb, Nnn, Naa )         ! ocean initial state (Dynamics and tracers) 
    … …  
    430430            CALL dia_obs_init( Nnn )                ! Initialize observational data 
    431431            CALL dia_obs( nit000 - 1, Nnn )         ! Observation operator for restart 
    432          ENDIF      
     432         ENDIF 
    433433         IF( lk_asminc )   CALL asm_inc_init( Nbb, Nnn, Nrhs )   ! Assimilation increments 
    434434         ! 
    … …  
    439439                           CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers) 
    440440 
    441       !                                      ! external forcing  
     441      !                                      ! external forcing 
    442442                           CALL    tide_init                     ! tidal harmonics 
    443443                           CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
    … …  
    446446      !                                      ! Ocean physics 
    447447                           CALL zdf_phy_init( Nnn )    ! Vertical physics 
    448                                       
     448 
    449449      !                                         ! Lateral physics 
    450450                           CALL ldf_tra_init      ! Lateral ocean tracer physics 
    … …  
    482482                           CALL sto_par_init    ! Stochastic parametrization 
    483483      IF( ln_sto_eos   )   CALL sto_pts_init    ! RRandom T/S fluctuations 
    484       
     484 
    485485      !                                      ! Diagnostics 
    486486                           CALL     flo_init( Nnn )    ! drifting Floats 
    … …  
    526526         WRITE(numout,*) '                              sn_cfctl%l_prttrc  = ', sn_cfctl%l_prttrc 
    527527         WRITE(numout,*) '                              sn_cfctl%l_oasout  = ', sn_cfctl%l_oasout 
    528          WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin   
    529          WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax   
    530          WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    531          WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
     528         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
     529         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
     530         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
     531         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
    532532         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    533533         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    … …  
    599599      !!---------------------------------------------------------------------- 
    600600      ! 
    601       ierr =        oce_alloc    ()    ! ocean  
     601      ierr =        oce_alloc    ()    ! ocean 
    602602      ierr = ierr + dia_wri_alloc() 
    603603      ierr = ierr + dom_oce_alloc()    ! ocean domain 
    … …  
    611611   END SUBROUTINE nemo_alloc 
    612612 
    613     
     613 
    614614   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    615615      !!---------------------------------------------------------------------- 

  • NEMO/trunk/src/OCE/par_oce.F90

    r13982 r14072  
    2222   ! 
    2323   LOGICAL       ::   ln_use_jattr     !: input file read offset 
    24    !                                   !  Use file global attribute: open_ocean_jstart to determine start j-row  
    25    !                                   !  when reading input from those netcdf files that have the  
    26    !                                   !  attribute defined. This is designed to enable input files associated  
    27    !                                   !  with the extended grids used in the under ice shelf configurations to  
     24   !                                   !  Use file global attribute: open_ocean_jstart to determine start j-row 
     25   !                                   !  when reading input from those netcdf files that have the 
     26   !                                   !  attribute defined. This is designed to enable input files associated 
     27   !                                   !  with the extended grids used in the under ice shelf configurations to 
    2828   !                                   !  be used without redundant rows when the ice shelves are not in use. 
    2929   LOGICAL       ::   ln_closea        !: (=T) special treatment of closed sea 
    30    !  
     30   ! 
    3131 
    3232   !!--------------------------------------------------------------------- 
    33    !! Domain Matrix size  
     33   !! Domain Matrix size 
    3434   !!--------------------------------------------------------------------- 
    3535   ! configuration name & resolution   (required only in ORCA family case) 
    3636   CHARACTER(lc) ::   cn_cfg           !: name of the configuration 
    37    INTEGER       ::   nn_cfg           !: resolution of the configuration  
     37   INTEGER       ::   nn_cfg           !: resolution of the configuration 
    3838 
    3939   ! time dimension 
    … …  
    8484   !!---------------------------------------------------------------------- 
    8585   !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj 
    86    INTEGER, PUBLIC            ::   jpni         !: number of processors following i  
     86   INTEGER, PUBLIC            ::   jpni         !: number of processors following i 
    8787   INTEGER, PUBLIC            ::   jpnj         !: number of processors following j 
    8888   INTEGER, PUBLIC            ::   jpnij        !: nb of local domain = nb of processors ( <= jpni x jpnj ) 
    89    INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo  
    90    INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo  
     89   INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo 
     90   INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo 
    9191 
    9292   ! halo with and starting/inding DO-loop indices 
    … …  
    101101   !!---------------------------------------------------------------------- 
    102102   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    103    !! $Id$  
     103   !! $Id$ 
    104104   !! Software governed by the CeCILL license (see ./LICENSE) 
    105105   !!====================================================================== 

  • NEMO/trunk/src/OCE/step.F90

    r14053 r14072  
    2727   !!            3.6  !  2014-04  (F. Roquet, G. Madec) New equations of state 
    2828   !!            3.6  !  2014-10  (E. Clementi, P. Oddo) Add Qiao vertical mixing in case of waves 
    29    !!            3.7  !  2014-10  (G. Madec)  LDF simplication  
     29   !!            3.7  !  2014-10  (G. Madec)  LDF simplication 
    3030   !!             -   !  2014-12  (G. Madec) remove KPP scheme 
    3131   !!             -   !  2015-11  (J. Chanut) free surface simplification (remove filtered free surface) 
    … …  
    109109      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    110110      ! 
    111       IF( l_1st_euler ) THEN   
     111      IF( l_1st_euler ) THEN 
    112112         ! start or restart with Euler 1st time-step 
    113          rDt =  rn_Dt    
     113         rDt =  rn_Dt 
    114114         r1_Dt = 1._wp / rDt 
    115115      ENDIF 
    116116      ! 
    117117      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    118       ! update I/O and calendar  
     118      ! update I/O and calendar 
    119119      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    120120      IF( kstp == nit000 ) THEN                       ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    … …  
    149149      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    150150      IF( ln_tide    )   CALL tide_update( kstp )                     ! update tide potential 
    151       IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                        ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib)  
     151      IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                        ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib) 
    152152      IF( ln_bdy     )   CALL bdy_dta ( kstp, Nnn )                   ! update dynamic & tracer data at open boundaries 
    153153      IF( ln_isf     )   CALL isf_stp ( kstp, Nnn ) 
    … …  
    184184            &            CALL zps_hde_isf( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF) 
    185185            &                                          rhd, gru , grv , grui, grvi   )       ! of t, s, rd at the first ocean level 
    186          IF( ln_traldf_triad ) THEN  
     186         IF( ln_traldf_triad ) THEN 
    187187                         CALL ldf_slp_triad( kstp, Nbb, Nnn )             ! before slope for triad operator 
    188          ELSE      
     188         ELSE 
    189189                         CALL ldf_slp     ( kstp, rhd, rn2b, Nbb, Nnn )   ! before slope for standard operator 
    190190         ENDIF 
    … …  
    192192      !                                                                        ! eddy diffusivity coeff. 
    193193      IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kstp, Nbb, Nnn )  !       and/or eiv coeff. 
    194       IF( l_ldfdyn_time                    )   CALL ldf_dyn( kstp, Nbb )       ! eddy viscosity coeff.  
     194      IF( l_ldfdyn_time                    )   CALL ldf_dyn( kstp, Nbb )       ! eddy viscosity coeff. 
    195195 
    196196      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    199199 
    200200                            CALL ssh_nxt       ( kstp, Nbb, Nnn, ssh, Naa )    ! after ssh (includes call to div_hor) 
    201       IF( .NOT.ln_linssh )  CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn,      Naa )    ! after vertical scale factors  
    202                             CALL wzv           ( kstp, Nbb, Nnn, Naa, ww  )    ! now cross-level velocity  
     201      IF( .NOT.ln_linssh )  CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn,      Naa )    ! after vertical scale factors 
     202                            CALL wzv           ( kstp, Nbb, Nnn, Naa, ww  )    ! now cross-level velocity 
    203203      IF( ln_zad_Aimp )     CALL wAimp         ( kstp,      Nnn           )  ! Adaptive-implicit vertical advection partitioning 
    204204                            CALL eos    ( ts(:,:,:,:,Nnn), rhd, rhop, gdept(:,:,:,Nnn) )  ! now in situ density for hpg computation 
    205                              
    206                              
     205 
     206 
    207207                         uu(:,:,:,Nrhs) = 0._wp            ! set dynamics trends to zero 
    208208                         vv(:,:,:,Nrhs) = 0._wp 
    … …  
    212212      IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends 
    213213#if defined key_agrif 
    214       IF(.NOT. Agrif_Root())  &  
     214      IF(.NOT. Agrif_Root())  & 
    215215               &         CALL Agrif_Sponge_dyn        ! momentum sponge 
    216216#endif 
    … …  
    229229                            CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion 
    230230      IF( ln_dynspg_ts ) THEN                                                       ! vertical scale factors and vertical velocity need to be updated 
    231                             CALL wzv        ( kstp, Nbb, Nnn, Naa, ww )             ! now cross-level velocity  
     231                            CALL wzv        ( kstp, Nbb, Nnn, Naa, ww )             ! now cross-level velocity 
    232232         IF( ln_zad_Aimp )  CALL wAimp      ( kstp,      Nnn )                      ! Adaptive-implicit vertical advection partitioning 
    233233      ENDIF 
    234        
     234 
    235235 
    236236      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    237237      ! cool skin 
    238       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
     238      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    239239      IF ( ln_diurnal )  CALL diurnal_layers( kstp ) 
    240        
     240 
    241241      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    242242      ! diagnostics and outputs 
    … …  
    252252      IF( lk_diadetide ) CALL dia_detide( kstp )                ! Weights computation for daily detiding of model diagnostics 
    253253      IF( lk_diamlr  )   CALL dia_mlr                           ! Update time used in multiple-linear-regression analysis 
    254        
     254 
    255255#if defined key_top 
    256256      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    261261 
    262262      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    263       ! Active tracers                               
     263      ! Active tracers 
    264264      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    265265      ! Loop over tile domains 
    … …  
    294294 
    295295                            CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection ==> RHS 
    296          IF( ln_zdfmfc  )   CALL tra_mfc    ( kstp, Nbb,      ts, Nrhs )  ! Mass Flux Convection  
     296         IF( ln_zdfmfc  )   CALL tra_mfc    ( kstp, Nbb,      ts, Nrhs )  ! Mass Flux Convection 
    297297         IF( ln_zdfosm  )   CALL tra_osm    ( kstp,      Nnn, ts, Nrhs )  ! OSMOSIS non-local tracer fluxes ==> RHS 
    298298         IF( lrst_oce .AND. ln_zdfosm ) & 
    … …  
    308308      ! Set boundary conditions, time filter and swap time levels 
    309309      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    310 !!jc1: For agrif, it would be much better to finalize tracers/momentum here (e.g. bdy conditions) and move the swap  
    311 !!    (and time filtering) after Agrif update. Then restart would be done after and would contain updated fields.  
    312 !!    If so:  
     310!!jc1: For agrif, it would be much better to finalize tracers/momentum here (e.g. bdy conditions) and move the swap 
     311!!    (and time filtering) after Agrif update. Then restart would be done after and would contain updated fields. 
     312!!    If so: 
    313313!!    (i) no need to call agrif update at initialization time 
    314 !!    (ii) no need to update "before" fields  
     314!!    (ii) no need to update "before" fields 
    315315!! 
    316 !!    Apart from creating new tra_swp/dyn_swp routines, this however:  
    317 !!    (i) makes boundary conditions at initialization time computed from updated fields which is not the case between  
    318 !!    two restarts => restartability issue. One can circumvent this, maybe, by assuming "interface separation",  
    319 !!    e.g. a shift of the feedback interface inside child domain.  
     316!!    Apart from creating new tra_swp/dyn_swp routines, this however: 
     317!!    (i) makes boundary conditions at initialization time computed from updated fields which is not the case between 
     318!!    two restarts => restartability issue. One can circumvent this, maybe, by assuming "interface separation", 
     319!!    e.g. a shift of the feedback interface inside child domain. 
    320320!!    (ii) requires that all restart outputs of updated variables by agrif (e.g. passive tracers/tke/barotropic arrays) are done at the same 
    321321!!    place. 
    322 !!  
     322!! 
    323323!!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 
    324324                         CALL tra_atf       ( kstp, Nbb, Nnn, Naa, ts )                      ! time filtering of "now" tracer arrays 
    … …  
    347347      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    348348      ! AGRIF recursive integration 
    349       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
     349      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    350350                         Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs      ! agrif_oce module copies of time level indices 
    351351                         CALL Agrif_Integrate_ChildGrids( stp )       ! allows to finish all the Child Grids before updating 
    … …  
    360360      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    361361      ! AGRIF update 
    362       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
     362      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    363363      IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN 
    364364                         CALL Agrif_update_all( )                  ! Update all components 
    … …  
    370370      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    371371      ! File manipulation at the end of the first time step 
    372       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          
     372      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    373373      IF( kstp == nit000 ) THEN                          ! 1st time step only 
    374374                                        CALL iom_close( numror )   ! close input  ocean restart file 
    … …  
    386386      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    387387      ! Finalize contextes if end of simulation or error detected 
    388       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          
    389       IF( kstp == nitend .OR. nstop > 0 ) THEN  
     388      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     389      IF( kstp == nitend .OR. nstop > 0 ) THEN 
    390390                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF 
    391          IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) !  
     391         IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 
    392392      ENDIF 
    393393#endif 
    394394      ! 
    395395      IF( l_1st_euler ) THEN         ! recover Leap-frog timestep 
    396          rDt = 2._wp * rn_Dt    
     396         rDt = 2._wp * rn_Dt 
    397397         r1_Dt = 1._wp / rDt 
    398          l_1st_euler = .FALSE.       
     398         l_1st_euler = .FALSE. 
    399399      ENDIF 
    400400      ! 

  • NEMO/trunk/src/OCE/step_oce.F90

    r14053 r14072  
    66   !!====================================================================== 
    77   !! History :   3.3  !  2010-08  (C. Ethe)  Original code - reorganisation of the initial phase 
    8    !!             3.7  !  2014-01  (G. Madec) LDF simplication  
     8   !!             3.7  !  2014-01  (G. Madec) LDF simplication 
    99   !!---------------------------------------------------------------------- 
    1010   USE oce             ! ocean dynamics and tracers variables 
    … …  
    3535   USE domvvl          ! variable vertical scale factors  (dom_vvl_sf_nxt routine) 
    3636   !                                                      (dom_vvl_sf_swp routine) 
    37     
     37 
    3838   USE divhor          ! horizontal divergence            (div_hor routine) 
    3939   USE dynadv          ! advection                        (dyn_adv routine) 
    … …  
    6060 
    6161   USE stopar          ! Stochastic parametrization       (sto_par routine) 
    62    USE stopts  
     62   USE stopts 
    6363 
    6464   USE ldfslp          ! iso-neutral slopes               (ldf_slp routine) 
    … …  
    7373 
    7474   USE diu_layers      ! diurnal SST bulk and coolskin routines 
    75    USE sbc_oce         ! surface fluxes   
    76     
     75   USE sbc_oce         ! surface fluxes 
     76 
    7777   USE zpshde          ! partial step: hor. derivative     (zps_hde routine) 
    7878 

  • NEMO/trunk/src/OCE/timing.F90

    r13982 r14072  
    33   !!                     ***  MODULE  timing  *** 
    44   !!======================================================================== 
    5    !! History : 4.0  ! 2001-05  (R. Benshila)    
     5   !! History : 4.0  ! 2001-05  (R. Benshila) 
    66   !!------------------------------------------------------------------------ 
    77 
    88   !!------------------------------------------------------------------------ 
    9    !!   timming_init    : initialize timing process  
     9   !!   timming_init    : initialize timing process 
    1010   !!   timing_start    : start Timer 
    1111   !!   timing_stop     : stop  Timer 
    1212   !!   timing_reset    : end timing variable creation 
    13    !!   timing_finalize : compute stats and write output in calling w*_info  
    14    !!   timing_ini_var  : create timing variables  
     13   !!   timing_finalize : compute stats and write output in calling w*_info 
     14   !!   timing_ini_var  : create timing variables 
    1515   !!   timing_listing  : print instumented subroutines in ocean.output 
    1616   !!   wcurrent_info   : compute and print detailed stats on the current CPU 
    1717   !!   wave_info       : compute and print averaged statson all processors 
    18    !!   wmpi_info       : compute and write global stats   
    19    !!   supress         : suppress an element of the timing linked list   
    20    !!   insert          : insert an element of the timing linked list   
     18   !!   wmpi_info       : compute and write global stats 
     19   !!   supress         : suppress an element of the timing linked list 
     20   !!   insert          : insert an element of the timing linked list 
    2121   !!------------------------------------------------------------------------ 
    22    USE in_out_manager  ! I/O manager  
     22   USE in_out_manager  ! I/O manager 
    2323   USE dom_oce         ! ocean domain 
    24    USE lib_mpp           
    25     
     24   USE lib_mpp 
     25 
    2626   IMPLICIT NONE 
    2727   PRIVATE 
    2828 
    29    PUBLIC   timing_init, timing_finalize   ! called in nemogcm module  
    30    PUBLIC   timing_reset                   ! called in step module  
    31    PUBLIC   timing_start, timing_stop      ! called in each routine to time  
    32     
     29   PUBLIC   timing_init, timing_finalize   ! called in nemogcm module 
     30   PUBLIC   timing_reset                   ! called in step module 
     31   PUBLIC   timing_start, timing_stop      ! called in each routine to time 
     32 
    3333#if defined key_mpp_mpi 
    3434   INCLUDE 'mpif.h' 
    … …  
    4141      INTEGER :: rank 
    4242      REAL(wp)  :: t_cpu, t_clock, tsum_cpu, tsum_clock, tmax_cpu, tmax_clock, tmin_cpu, tmin_clock, tsub_cpu, tsub_clock 
    43       INTEGER :: ncount, ncount_max, ncount_rate   
     43      INTEGER :: ncount, ncount_max, ncount_rate 
    4444      INTEGER :: niter 
    4545      LOGICAL :: l_tdone 
    … …  
    4848      TYPE(timer), POINTER :: parent_section => NULL() 
    4949   END TYPE timer 
    50      
     50 
    5151   TYPE alltimer 
    5252      CHARACTER(LEN=20), DIMENSION(:), POINTER :: cname => NULL() 
    … …  
    5656      TYPE(alltimer), POINTER :: next => NULL() 
    5757      TYPE(alltimer), POINTER :: prev => NULL() 
    58    END TYPE alltimer  
    59   
     58   END TYPE alltimer 
     59 
    6060   TYPE(timer), POINTER :: s_timer_root => NULL() 
    6161   TYPE(timer), POINTER :: s_timer      => NULL() 
    … …  
    6666   LOGICAL :: l_initdone = .FALSE. 
    6767   INTEGER :: nsize 
    68     
     68 
    6969   ! Variables for coarse grain timing 
    7070   REAL(wp) :: tot_etime, tot_ctime 
    … …  
    7676   CHARACTER(LEN=10), DIMENSION(2) :: ctime 
    7777   CHARACTER(LEN=5)                :: czone 
    78      
     78 
    7979   ! From of ouput file (1/proc or one global)   !RB to put in nammpp or namctl 
    80    LOGICAL :: ln_onefile = .TRUE.  
     80   LOGICAL :: ln_onefile = .TRUE. 
    8181   LOGICAL :: lwriter 
    8282   !!---------------------------------------------------------------------- 
    … …  
    9696       IF(ASSOCIATED(s_timer) ) s_timer_old => s_timer 
    9797       ! 
    98       ! Create timing structure at first call of the routine  
     98      ! Create timing structure at first call of the routine 
    9999       CALL timing_ini_var(cdinfo) 
    100100   !   write(*,*) 'after inivar ', s_timer%cname 
    … …  
    102102      ! ici timing_ini_var a soit retrouve s_timer et fait return soit ajoute un maillon 
    103103      ! maintenant on regarde si le call d'avant corrsspond a un parent ou si il est ferme 
    104       IF( .NOT. s_timer_old%l_tdone ) THEN       
     104      IF( .NOT. s_timer_old%l_tdone ) THEN 
    105105         s_timer%parent_section => s_timer_old 
    106106      ELSE 
    107107         s_timer%parent_section => NULL() 
    108       ENDIF     
     108      ENDIF 
    109109 
    110110      s_timer%l_tdone = .FALSE. 
    … …  
    112112      s_timer%t_cpu = 0. 
    113113      s_timer%t_clock = 0. 
    114                    
     114 
    115115      ! CPU time collection 
    116116      CALL CPU_TIME( s_timer%t_cpu  ) 
    … …  
    136136      CHARACTER(len=*), INTENT(in), OPTIONAL :: csection 
    137137      ! 
    138       INTEGER  :: ifinal_count, iperiods     
     138      INTEGER  :: ifinal_count, iperiods 
    139139      REAL(wp) :: zcpu_end, zmpitime,zcpu_raw,zclock_raw 
    140140      ! 
    … …  
    152152!!$      IF(associated(s_timer%parent_section))then 
    153153!!$        write(*,*) s_timer%cname,' <-- ', s_timer%parent_section%cname 
    154 !!$      ENDIF   
     154!!$      ENDIF 
    155155 
    156156 !     No need to search ... : s_timer has the last value defined in start 
    157157 !     s_timer => s_timer_root 
    158  !     DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) )  
     158 !     DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) ) 
    159159 !        IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next 
    160160 !     END DO 
    161   
     161 
    162162      ! CPU time correction 
    163163      zcpu_raw = zcpu_end - s_timer%t_cpu - t_overcpu ! total time including child 
    … …  
    172172      iperiods = ifinal_count - s_timer%ncount 
    173173      IF( ifinal_count < s_timer%ncount )  & 
    174          iperiods = iperiods + s_timer%ncount_max  
    175          zclock_raw = REAL(iperiods) / s_timer%ncount_rate !- t_overclock    
     174         iperiods = iperiods + s_timer%ncount_max 
     175         zclock_raw = REAL(iperiods) / s_timer%ncount_rate !- t_overclock 
    176176         s_timer%t_clock  = zclock_raw - s_timer%tsub_clock 
    177177#endif 
    178178 !     IF(s_timer%cname==trim('lbc_lnk_2d')) write(*,*) zclock_raw , s_timer%tsub_clock 
    179        
     179 
    180180      ! Correction of parent section 
    181181      IF( .NOT. PRESENT(csection) ) THEN 
    182182         IF ( ASSOCIATED(s_timer%parent_section ) ) THEN 
    183             s_timer%parent_section%tsub_cpu   = zcpu_raw   + s_timer%parent_section%tsub_cpu  
    184             s_timer%parent_section%tsub_clock = zclock_raw + s_timer%parent_section%tsub_clock              
     183            s_timer%parent_section%tsub_cpu   = zcpu_raw   + s_timer%parent_section%tsub_cpu 
     184            s_timer%parent_section%tsub_clock = zclock_raw + s_timer%parent_section%tsub_clock 
    185185         ENDIF 
    186186      ENDIF 
    187              
    188       ! time diagnostics  
    189       s_timer%tsum_clock = s_timer%tsum_clock + s_timer%t_clock  
     187 
     188      ! time diagnostics 
     189      s_timer%tsum_clock = s_timer%tsum_clock + s_timer%t_clock 
    190190      s_timer%tsum_cpu   = s_timer%tsum_cpu   + s_timer%t_cpu 
    191191!RB to use to get min/max during a time integration 
    192192!      IF( .NOT. l_initdone ) THEN 
    193 !         s_timer%tmin_clock = s_timer%t_clock  
    194 !         s_timer%tmin_cpu   = s_timer%t_cpu  
     193!         s_timer%tmin_clock = s_timer%t_clock 
     194!         s_timer%tmin_cpu   = s_timer%t_cpu 
    195195!      ELSE 
    196 !         s_timer%tmin_clock = MIN( s_timer%tmin_clock, s_timer%t_clock )  
    197 !         s_timer%tmin_cpu   = MIN( s_timer%tmin_cpu  , s_timer%t_cpu   )  
    198 !      ENDIF    
    199 !      s_timer%tmax_clock = MAX( s_timer%tmax_clock, s_timer%t_clock )  
    200 !      s_timer%tmax_cpu   = MAX( s_timer%tmax_cpu  , s_timer%t_cpu   )   
     196!         s_timer%tmin_clock = MIN( s_timer%tmin_clock, s_timer%t_clock ) 
     197!         s_timer%tmin_cpu   = MIN( s_timer%tmin_cpu  , s_timer%t_cpu   ) 
     198!      ENDIF 
     199!      s_timer%tmax_clock = MAX( s_timer%tmax_clock, s_timer%t_clock ) 
     200!      s_timer%tmax_cpu   = MAX( s_timer%tmax_cpu  , s_timer%t_cpu   ) 
    201201      ! 
    202202      s_timer%tsub_clock = 0. 
    … …  
    207207      ! we come back 
    208208      IF ( ASSOCIATED(s_timer%parent_section ) ) s_timer => s_timer%parent_section 
    209       
     209 
    210210!      write(*,*) 'end of stop ', s_timer%cname 
    211211 
    212212   END SUBROUTINE timing_stop 
    213   
    214   
     213 
     214 
    215215   SUBROUTINE timing_init( clname ) 
    216216      !!---------------------------------------------------------------------- 
    … …  
    235235         lwriter = .TRUE. 
    236236      ENDIF 
    237        
    238       IF( lwriter) THEN       
     237 
     238      IF( lwriter) THEN 
    239239         WRITE(numtime,*) 
    240240         WRITE(numtime,*) '      CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC - INGV' 
    … …  
    246246         WRITE(numtime,*) 
    247247         WRITE(numtime,*) 
    248       ENDIF    
    249        
     248      ENDIF 
     249 
    250250      ! Compute clock function overhead 
    251 #if defined key_mpp_mpi         
     251#if defined key_mpp_mpi 
    252252      t_overclock = MPI_WTIME() 
    253253      t_overclock = MPI_WTIME() - t_overclock 
    254 #else         
     254#else 
    255255      CALL SYSTEM_CLOCK(COUNT_RATE=ncount_rate, COUNT_MAX=ncount_max) 
    256256      CALL SYSTEM_CLOCK(COUNT = istart_count) 
    … …  
    258258      iperiods = ifinal_count - istart_count 
    259259      IF( ifinal_count < istart_count )  & 
    260           iperiods = iperiods + ncount_max  
     260          iperiods = iperiods + ncount_max 
    261261      t_overclock = REAL(iperiods) / ncount_rate 
    262262#endif 
    … …  
    265265      CALL CPU_TIME(zdum) 
    266266      CALL CPU_TIME(t_overcpu) 
    267        
    268       ! End overhead omputation   
    269       t_overcpu = t_overcpu - zdum         
    270       t_overclock = t_overcpu + t_overclock         
     267 
     268      ! End overhead omputation 
     269      t_overcpu = t_overcpu - zdum 
     270      t_overclock = t_overcpu + t_overclock 
    271271 
    272272      ! Timing on date and time 
    273273      CALL DATE_AND_TIME(cdate(1),ctime(1),czone,nvalues) 
    274      
    275       CALL CPU_TIME(t_cpu(1))       
    276 #if defined key_mpp_mpi         
     274 
     275      CALL CPU_TIME(t_cpu(1)) 
     276#if defined key_mpp_mpi 
    277277      ! Start elapsed and CPU time counters 
    278278      t_elaps(1) = MPI_WTIME() 
    … …  
    280280      CALL SYSTEM_CLOCK(COUNT_RATE=ncount_rate, COUNT_MAX=ncount_max) 
    281281      CALL SYSTEM_CLOCK(COUNT = ncount) 
    282 #endif                  
     282#endif 
    283283      ! 
    284284   END SUBROUTINE timing_init 
    … …  
    288288      !!---------------------------------------------------------------------- 
    289289      !!               ***  ROUTINE timing_finalize *** 
    290       !! ** Purpose :  compute average time  
     290      !! ** Purpose :  compute average time 
    291291      !!               write timing output file 
    292292      !!---------------------------------------------------------------------- 
    … …  
    295295      INTEGER :: ji 
    296296      LOGICAL :: ll_ord, ll_averep 
    297       CHARACTER(len=120) :: clfmt             
     297      CHARACTER(len=120) :: clfmt 
    298298      REAL(wp), DIMENSION(:), ALLOCATABLE ::   timing_glob 
    299299      REAL(wp) ::   zsypd   ! simulated years per day (Balaji 2017) 
    … …  
    301301 
    302302      ll_averep = .TRUE. 
    303      
     303 
    304304      ! total CPU and elapse 
    305305      CALL CPU_TIME(t_cpu(2)) 
    … …  
    311311      iperiods = nfinal_count - ncount 
    312312      IF( nfinal_count < ncount )  & 
    313           iperiods = iperiods + ncount_max  
     313          iperiods = iperiods + ncount_max 
    314314      t_elaps(2) = REAL(iperiods) / ncount_rate - t_overclock 
    315 #endif       
     315#endif 
    316316 
    317317      ! End of timings on date & time 
    318318      CALL DATE_AND_TIME(cdate(2),ctime(2),czone,nvalues) 
    319         
     319 
    320320      ! Compute the numer of routines 
    321       nsize = 0  
     321      nsize = 0 
    322322      s_timer => s_timer_root 
    323323      DO WHILE( ASSOCIATED(s_timer) ) 
    … …  
    334334         IF( lwriter ) WRITE(numtime,*) 
    335335         ll_averep = .FALSE. 
    336       ENDIF    
    337  
    338 #if defined key_mpp_mpi       
     336      ENDIF 
     337 
     338#if defined key_mpp_mpi 
    339339      ! in MPI gather some info 
    340340      ALLOCATE( all_etime(jpnij), all_ctime(jpnij) ) 
    … …  
    349349#else 
    350350      tot_etime = t_elaps(2) 
    351       tot_ctime = t_cpu  (2)            
     351      tot_ctime = t_cpu  (2) 
    352352#endif 
    353353 
    354354      ! write output file 
    355       IF( lwriter ) WRITE(numtime,*)  
    356       IF( lwriter ) WRITE(numtime,*)  
     355      IF( lwriter ) WRITE(numtime,*) 
     356      IF( lwriter ) WRITE(numtime,*) 
    357357      IF( lwriter ) WRITE(numtime,*) 'Total timing (sum) :' 
    358358      IF( lwriter ) WRITE(numtime,*) '--------------------' 
    359359      IF( lwriter ) WRITE(numtime,"('Elapsed Time (s)  CPU Time (s)')") 
    360360      IF( lwriter ) WRITE(numtime,'(5x,f12.3,1x,f12.3)')  tot_etime, tot_ctime 
    361       IF( lwriter ) WRITE(numtime,*)  
     361      IF( lwriter ) WRITE(numtime,*) 
    362362#if defined key_mpp_mpi 
    363363      IF( ll_averep ) CALL waver_info 
    364364      CALL wmpi_info 
    365 #endif       
     365#endif 
    366366      IF( lwriter ) CALL wcurrent_info 
    367        
     367 
    368368      clfmt='(1X,"Timing started on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")' 
    369       IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &            
     369      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) & 
    370370      &       cdate(1)(7:8), cdate(1)(5:6), cdate(1)(1:4),   & 
    371371      &       ctime(1)(1:2), ctime(1)(3:4), ctime(1)(5:6),   & 
    372       &       czone(1:3),    czone(4:5)                      
     372      &       czone(1:3),    czone(4:5) 
    373373      clfmt='(1X,  "Timing   ended on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")' 
    374       IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &            
     374      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) & 
    375375      &       cdate(2)(7:8), cdate(2)(5:6), cdate(2)(1:4),   & 
    376376      &       ctime(2)(1:2), ctime(2)(3:4), ctime(2)(5:6),   & 
    … …  
    402402      ENDIF 
    403403      DEALLOCATE(timing_glob) 
    404 #endif       
    405  
    406       IF( lwriter ) CLOSE(numtime)  
     404#endif 
     405 
     406      IF( lwriter ) CLOSE(numtime) 
    407407      ! 
    408408   END SUBROUTINE timing_finalize 
    409     
     409 
    410410 
    411411   SUBROUTINE wcurrent_info 
    … …  
    415415      !!---------------------------------------------------------------------- 
    416416      LOGICAL :: ll_ord 
    417       CHARACTER(len=2048) :: clfmt             
    418     
    419       ! reorder the current list by elapse time       
     417      CHARACTER(len=2048) :: clfmt 
     418 
     419      ! reorder the current list by elapse time 
    420420      s_wrk => NULL() 
    421421      s_timer => s_timer_root 
    … …  
    425425         DO WHILE ( ASSOCIATED( s_timer%next ) ) 
    426426            IF (.NOT. ASSOCIATED(s_timer%next)) EXIT 
    427             IF ( s_timer%tsum_clock < s_timer%next%tsum_clock ) THEN  
     427            IF ( s_timer%tsum_clock < s_timer%next%tsum_clock ) THEN 
    428428               ALLOCATE(s_wrk) 
    429429               s_wrk = s_timer%next 
    430430               CALL insert  (s_timer, s_timer_root, s_wrk) 
    431                CALL suppress(s_timer%next)             
     431               CALL suppress(s_timer%next) 
    432432               ll_ord = .FALSE. 
    433                CYCLE             
     433               CYCLE 
    434434            ENDIF 
    435435            IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next 
    … …  
    437437         IF( ll_ord ) EXIT 
    438438      END DO 
    439              
     439 
    440440      ! write current info 
    441441      WRITE(numtime,*) 'Detailed timing for proc :', narea-1 
    … …  
    443443      WRITE(numtime,*) 'Section             ',            & 
    444444      &   'Elapsed Time (s)  ','Elapsed Time (%)  ',   & 
    445       &   'CPU Time(s)  ','CPU Time (%)  ','CPU/Elapsed  ','Frequency'  
    446       s_timer => s_timer_root   
     445      &   'CPU Time(s)  ','CPU Time (%)  ','CPU/Elapsed  ','Frequency' 
     446      s_timer => s_timer_root 
    447447      clfmt = '(1x,a,4x,f12.3,6x,f12.3,x,f12.3,2x,f12.3,6x,f7.3,2x,i9)' 
    448448      DO WHILE ( ASSOCIATED(s_timer) ) 
    … …  
    455455      END DO 
    456456      WRITE(numtime,*) 
    457       !                   
     457      ! 
    458458   END SUBROUTINE wcurrent_info 
    459459 
    460 #if defined key_mpp_mpi      
     460#if defined key_mpp_mpi 
    461461   SUBROUTINE waver_info 
    462462      !!---------------------------------------------------------------------- 
    … …  
    470470      INTEGER :: icode 
    471471      INTEGER :: ierr 
    472       LOGICAL :: ll_ord            
    473       CHARACTER(len=200) :: clfmt               
    474                   
    475       ! Initialised the global strucutre    
     472      LOGICAL :: ll_ord 
     473      CHARACTER(len=200) :: clfmt 
     474 
     475      ! Initialised the global strucutre 
    476476      ALLOCATE(sl_timer_glob_root, Stat=ierr) 
    477477      IF(ierr /= 0)THEN 
    … …  
    524524         sl_timer_ave_root%prev => NULL() 
    525525         ALLOCATE(sl_timer_ave) 
    526          sl_timer_ave => sl_timer_ave_root             
    527       ENDIF  
     526         sl_timer_ave => sl_timer_ave_root 
     527      ENDIF 
    528528 
    529529      ! Gather info from all processors 
    … …  
    552552            sl_timer_glob%next%next => NULL() 
    553553            sl_timer_glob           => sl_timer_glob%next 
    554          ENDIF               
     554         ENDIF 
    555555         s_timer => s_timer%next 
    556       END DO       
    557        
    558       IF( narea == 1 ) THEN     
     556      END DO 
     557 
     558      IF( narea == 1 ) THEN 
    559559         ! Compute some stats 
    560560         sl_timer_glob => sl_timer_glob_root 
    … …  
    570570            ! 
    571571            IF( ASSOCIATED(sl_timer_glob%next) ) THEN 
    572                ALLOCATE(sl_timer_ave%next)           
     572               ALLOCATE(sl_timer_ave%next) 
    573573               sl_timer_ave%next%prev => sl_timer_ave 
    574                sl_timer_ave%next%next => NULL()            
     574               sl_timer_ave%next%next => NULL() 
    575575               sl_timer_ave           => sl_timer_ave%next 
    576576            ENDIF 
    577             sl_timer_glob => sl_timer_glob%next                                 
     577            sl_timer_glob => sl_timer_glob%next 
    578578         END DO 
    579        
    580          ! reorder the averaged list by CPU time       
     579 
     580         ! reorder the averaged list by CPU time 
    581581         s_wrk => NULL() 
    582582         sl_timer_ave => sl_timer_ave_root 
    … …  
    588588               IF( .NOT. ASSOCIATED(sl_timer_ave%next) ) EXIT 
    589589 
    590                IF ( sl_timer_ave%tsum_clock < sl_timer_ave%next%tsum_clock ) THEN  
     590               IF ( sl_timer_ave%tsum_clock < sl_timer_ave%next%tsum_clock ) THEN 
    591591                  ALLOCATE(s_wrk) 
    592592                  ! Copy data into the new object pointed to by s_wrk 
    … …  
    595595                  CALL insert  (sl_timer_ave, sl_timer_ave_root, s_wrk) 
    596596                  ! Remove the old object from the list 
    597                   CALL suppress(sl_timer_ave%next)             
     597                  CALL suppress(sl_timer_ave%next) 
    598598                  ll_ord = .FALSE. 
    599                   CYCLE             
    600                ENDIF            
     599                  CYCLE 
     600               ENDIF 
    601601               IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next 
    602             END DO          
     602            END DO 
    603603            IF( ll_ord ) EXIT 
    604604         END DO 
    … …  
    609609         WRITE(numtime,"('Section',13x,'Elap. Time(s)',2x,'Elap. Time(%)',2x, & 
    610610         &   'CPU Time(s)',2x,'CPU Time(%)',2x,'CPU/Elap',1x,   & 
    611          &   'Max elap(%)',2x,'Min elap(%)',2x,            &            
     611         &   'Max elap(%)',2x,'Min elap(%)',2x,            & 
    612612         &   'Freq')") 
    613          sl_timer_ave => sl_timer_ave_root   
     613         sl_timer_ave => sl_timer_ave_root 
    614614         clfmt = '((A),E15.7,2x,f6.2,5x,f12.2,5x,f6.2,5x,f7.2,2x,f12.2,4x,f6.2,2x,f9.2)' 
    615615         DO WHILE ( ASSOCIATED(sl_timer_ave) ) 
    616             IF( sl_timer_ave%tsum_clock > 0. )                                             &  
     616            IF( sl_timer_ave%tsum_clock > 0. )                                             & 
    617617               WRITE(numtime,TRIM(clfmt))   sl_timer_ave%cname(1:18),                      & 
    618618               &   sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime,   & 
    … …  
    630630      ! 
    631631      DEALLOCATE(sl_timer_glob_root) 
    632       !                   
     632      ! 
    633633   END SUBROUTINE waver_info 
    634    
    635    
     634 
     635 
    636636   SUBROUTINE wmpi_info 
    637637      !!---------------------------------------------------------------------- 
    638638      !!               ***  ROUTINE wmpi_time  *** 
    639       !! ** Purpose :   compute and write a summary of MPI infos  
    640       !!----------------------------------------------------------------------    
    641       !    
     639      !! ** Purpose :   compute and write a summary of MPI infos 
     640      !!---------------------------------------------------------------------- 
     641      ! 
    642642      INTEGER                            :: idum, icode 
    643643      INTEGER, ALLOCATABLE, DIMENSION(:) :: iall_rank 
    … …  
    648648      CHARACTER(LEN=128), dimension(8) :: cllignes 
    649649      CHARACTER(LEN=128)               :: clhline, clstart_date, clfinal_date 
    650       CHARACTER(LEN=2048)              :: clfmt     
    651     
     650      CHARACTER(LEN=2048)              :: clfmt 
     651 
    652652      ! Gather all times 
    653653      ALLOCATE( zall_ratio(jpnij), iall_rank(jpnij) ) 
    654654      IF( narea == 1 ) THEN 
    655655         iall_rank(:) = (/ (idum,idum=0,jpnij-1) /) 
    656     
     656 
    657657         ! Compute elapse user time 
    658658         zavg_etime = tot_etime/REAL(jpnij,wp) 
    … …  
    664664         zmax_ctime = MAXVAL(all_ctime(:)) 
    665665         zmin_ctime = MINVAL(all_ctime(:)) 
    666     
     666 
    667667         ! Compute cpu/elapsed ratio 
    668668         zall_ratio(:) = all_ctime(:) / all_etime(:) 
    … …  
    670670         zavg_ratio    = SUM(zall_ratio(:))/REAL(jpnij,wp) 
    671671         zmax_ratio    = MAXVAL(zall_ratio(:)) 
    672          zmin_ratio    = MINVAL(zall_ratio(:))    
    673     
     672         zmin_ratio    = MINVAL(zall_ratio(:)) 
     673 
    674674         ! Output Format 
    675675         clhline    ='1x,13("-"),"|",18("-"),"|",14("-"),"|",18("-"),/,' 
    … …  
    693693             zmax_etime,    zmax_ctime,    zmax_ratio,   & 
    694694             zavg_etime,    zavg_ctime,    zavg_ratio 
    695          WRITE(numtime,*)     
     695         WRITE(numtime,*) 
    696696      END IF 
    697697      ! 
    … …  
    699699      ! 
    700700   END SUBROUTINE wmpi_info 
    701 #endif    
     701#endif 
    702702 
    703703 
    … …  
    705705      !!---------------------------------------------------------------------- 
    706706      !!               ***  ROUTINE timing_ini_var  *** 
    707       !! ** Purpose :   create timing structure  
     707      !! ** Purpose :   create timing structure 
    708708      !!---------------------------------------------------------------------- 
    709709      CHARACTER(len=*), INTENT(in) :: cdinfo 
    710710      LOGICAL :: ll_section 
    711         
     711 
    712712      ! 
    713713      IF( .NOT. ASSOCIATED(s_timer_root) ) THEN 
    … …  
    760760         ! case of already existing area (typically inside a loop) 
    761761   !         write(*,*) 'in ini_var for routine : ', cdinfo 
    762          DO WHILE( ASSOCIATED(s_timer) )  
     762         DO WHILE( ASSOCIATED(s_timer) ) 
    763763            IF( TRIM(s_timer%cname) .EQ. TRIM(cdinfo) ) THEN 
    764  !             write(*,*) 'in ini_var for routine : ', cdinfo,' we return'            
     764 !             write(*,*) 'in ini_var for routine : ', cdinfo,' we return' 
    765765               RETURN ! cdinfo is already in the chain 
    766766            ENDIF 
    … …  
    775775 
    776776    !     write(*,*) 'after search', s_timer%cname 
    777          ! cdinfo is not part of the chain so we add it with initialisation           
     777         ! cdinfo is not part of the chain so we add it with initialisation 
    778778          ALLOCATE(s_timer%next) 
    779779    !     write(*,*) 'after allocation of next' 
    780    
     780 
    781781         s_timer%next%cname       = cdinfo 
    782782         s_timer%next%t_cpu      = 0._wp 
    783783         s_timer%next%t_clock    = 0._wp 
    784784         s_timer%next%tsum_cpu   = 0._wp 
    785          s_timer%next%tsum_clock = 0._wp   
     785         s_timer%next%tsum_clock = 0._wp 
    786786         s_timer%next%tmax_cpu   = 0._wp 
    787787         s_timer%next%tmax_clock = 0._wp 
    … …  
    799799         s_timer%next%next => NULL() 
    800800         s_timer => s_timer%next 
    801       ENDIF  
     801      ENDIF 
    802802      !    write(*,*) 'after allocation' 
    803803     ! 
    … …  
    808808      !!---------------------------------------------------------------------- 
    809809      !!               ***  ROUTINE timing_reset  *** 
    810       !! ** Purpose :   go to root of timing tree  
    811       !!---------------------------------------------------------------------- 
    812       l_initdone = .TRUE.  
     810      !! ** Purpose :   go to root of timing tree 
     811      !!---------------------------------------------------------------------- 
     812      l_initdone = .TRUE. 
    813813!      IF(lwp) WRITE(numout,*) 
    814814!      IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing' 
    … …  
    821821 
    822822   RECURSIVE SUBROUTINE timing_list(ptr) 
    823     
     823 
    824824      TYPE(timer), POINTER, INTENT(inout) :: ptr 
    825825      ! 
    826826      IF( ASSOCIATED(ptr%next) ) CALL timing_list(ptr%next) 
    827       IF(lwp) WRITE(numout,*)'   ', ptr%cname    
     827      IF(lwp) WRITE(numout,*)'   ', ptr%cname 
    828828      ! 
    829829   END SUBROUTINE timing_list 
    … …  
    837837      TYPE(timer), POINTER, INTENT(inout) :: sd_current, sd_root, sd_ptr 
    838838      ! 
    839       
     839 
    840840      IF( ASSOCIATED( sd_current, sd_root ) ) THEN 
    841841         ! If our current element is the root element then 
    … …  
    852852      ! to ALLOCATE memory to this pointer will fail. 
    853853      sd_ptr => NULL() 
    854       !     
     854      ! 
    855855   END SUBROUTINE insert 
    856    
    857    
     856 
     857 
    858858   SUBROUTINE suppress(sd_ptr) 
    859859      !!---------------------------------------------------------------------- 
    … …  
    864864      ! 
    865865      TYPE(timer), POINTER :: sl_temp 
    866      
     866 
    867867      sl_temp => sd_ptr 
    868       sd_ptr => sd_ptr%next     
     868      sd_ptr => sd_ptr%next 
    869869      IF ( ASSOCIATED(sl_temp%next) ) sl_temp%next%prev => sl_temp%prev 
    870870      DEALLOCATE(sl_temp) 
Note: See TracChangeset for help on using the changeset viewer.