Changeset 12377 for NEMO/trunk/src/OCE/SBC

Timestamp:

2020-02-12T15:39:06+01:00 (4 years ago)

Author:

acc

Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:

NEMO/trunk

Files:

• . (modified) (1 prop)
• src/OCE/SBC/abl.F90 (copied) (copied from NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/abl.F90)
• src/OCE/SBC/cpl_oasis3.F90 (modified) (24 diffs)
• src/OCE/SBC/cyclone.F90 (modified) (4 diffs)
• src/OCE/SBC/fldread.F90 (modified) (36 diffs)
• src/OCE/SBC/geo2ocean.F90 (modified) (3 diffs)
• src/OCE/SBC/sbc_oce.F90 (modified) (15 diffs)
• src/OCE/SBC/sbcabl.F90 (copied) (copied from NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcabl.F90)
• src/OCE/SBC/sbcapr.F90 (modified) (2 diffs)
• src/OCE/SBC/sbcblk.F90 (modified) (39 diffs)
• src/OCE/SBC/sbcblk_algo_coare.F90 (deleted)
• src/OCE/SBC/sbcblk_algo_coare3p0.F90 (copied) (copied from NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcblk_algo_coare3p0.F90)
• src/OCE/SBC/sbcblk_algo_coare3p5.F90 (deleted)
• src/OCE/SBC/sbcblk_algo_coare3p6.F90 (copied) (copied from NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcblk_algo_coare3p6.F90)
• src/OCE/SBC/sbcblk_algo_ecmwf.F90 (modified) (13 diffs)
• src/OCE/SBC/sbcblk_algo_ncar.F90 (modified) (15 diffs)
• src/OCE/SBC/sbcblk_phy.F90 (copied) (copied from NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcblk_phy.F90)
• src/OCE/SBC/sbcblk_skin_coare.F90 (copied) (copied from NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcblk_skin_coare.F90)
• src/OCE/SBC/sbcblk_skin_ecmwf.F90 (copied) (copied from NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcblk_skin_ecmwf.F90)
• src/OCE/SBC/sbcclo.F90 (copied) (copied from NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcclo.F90)
• src/OCE/SBC/sbccpl.F90 (modified) (56 diffs)
• src/OCE/SBC/sbcdcy.F90 (modified) (5 diffs)
• src/OCE/SBC/sbcflx.F90 (modified) (4 diffs)
• src/OCE/SBC/sbcfwb.F90 (modified) (7 diffs)
• src/OCE/SBC/sbcice_cice.F90 (modified) (35 diffs)
• src/OCE/SBC/sbcice_if.F90 (modified) (5 diffs)
• src/OCE/SBC/sbcisf.F90 (deleted)
• src/OCE/SBC/sbcmod.F90 (modified) (26 diffs)
• src/OCE/SBC/sbcrnf.F90 (modified) (10 diffs)
• src/OCE/SBC/sbcssm.F90 (modified) (10 diffs)
• src/OCE/SBC/sbcssr.F90 (modified) (4 diffs)
• src/OCE/SBC/sbctide.F90 (deleted)
• src/OCE/SBC/sbcwave.F90 (modified) (10 diffs)
• src/OCE/SBC/tide.h90 (deleted)
• src/OCE/SBC/tide_mod.F90 (deleted)
• src/OCE/SBC/tideini.F90 (deleted)
• src/OCE/SBC/updtide.F90 (deleted)

NEMO/trunk

@@ -3 +3 @@
 ^/utils/build/mk@HEAD         mk
 ^/utils/tools@HEAD            tools
-^/vendors/AGRIF/dev@HEAD      ext/AGRIF
+^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL

@@ -3 +3 @@
 ^/utils/build/mk@HEAD         mk
 ^/utils/tools@HEAD            tools
-^/vendors/AGRIF/dev@HEAD      ext/AGRIF
+^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL

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

@@ -114 +114 @@
       !------------------------------------------------------------------
       CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror )
-      IF ( nerror /= OASIS_Ok ) &
+      IF( nerror /= OASIS_Ok ) &
          CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
 
@@ -122 +122 @@
 
       CALL oasis_get_localcomm ( kl_comm, nerror )
-      IF ( nerror /= OASIS_Ok ) &
+      IF( nerror /= OASIS_Ok ) &
          CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' )
       !
@@ -149 +149 @@
 
       ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi_save = nldi   ;   nlei_save = nlei
          nldj_save = nldj   ;   nlej_save = nlej
@@ -203 +203 @@
       paral(5) = jpiglo                                         ! global extent in x
       
-      IF( ln_ctl ) THEN
+      IF( sn_cfctl%l_oasout ) THEN
          WRITE(numout,*) ' multiexchg: paral (1:5)', paral
          WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
@@ -217 +217 @@
       !
       DO ji = 1, ksnd
-         IF ( ssnd(ji)%laction ) THEN
+         IF( ssnd(ji)%laction ) THEN
 
             IF( ssnd(ji)%nct > nmaxcat ) THEN
@@ -228 +228 @@
                DO jm = 1, kcplmodel
 
-                  IF ( ssnd(ji)%nct .GT. 1 ) THEN
+                  IF( ssnd(ji)%nct .GT. 1 ) THEN
                      WRITE(cli2,'(i2.2)') jc
                      zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2
@@ -234 +234 @@
                      zclname = ssnd(ji)%clname
                   ENDIF
-                  IF ( kcplmodel  > 1 ) THEN
+                  IF( kcplmodel  > 1 ) THEN
                      WRITE(cli2,'(i2.2)') jm
                      zclname = 'model'//cli2//'_'//TRIM(zclname)
@@ -241 +241 @@
                   IF( agrif_fixed() /= 0 ) THEN 
                      zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
-                  END IF
-#endif
-                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
+                  ENDIF
+#endif
+                  IF( sn_cfctl%l_oasout ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
                   CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   &
                      &                OASIS_Out          , ishape , OASIS_REAL, nerror )
-                  IF ( nerror /= OASIS_Ok ) THEN
+                  IF( nerror /= OASIS_Ok ) THEN
                      WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
                      CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
                   ENDIF
-                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
-                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
+                  IF( sn_cfctl%l_oasout .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
+                  IF( sn_cfctl%l_oasout .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
                END DO
             END DO
@@ -262 +262 @@
       !
       DO ji = 1, krcv
-         IF ( srcv(ji)%laction ) THEN 
+         IF( srcv(ji)%laction ) THEN 
             
             IF( srcv(ji)%nct > nmaxcat ) THEN
@@ -273 +273 @@
                DO jm = 1, kcplmodel
                   
-                  IF ( srcv(ji)%nct .GT. 1 ) THEN
+                  IF( srcv(ji)%nct .GT. 1 ) THEN
                      WRITE(cli2,'(i2.2)') jc
                      zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2
@@ -279 +279 @@
                      zclname = srcv(ji)%clname
                   ENDIF
-                  IF ( kcplmodel  > 1 ) THEN
+                  IF( kcplmodel  > 1 ) THEN
                      WRITE(cli2,'(i2.2)') jm
                      zclname = 'model'//cli2//'_'//TRIM(zclname)
@@ -286 +286 @@
                   IF( agrif_fixed() /= 0 ) THEN 
                      zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
-                  END IF
-#endif
-                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
+                  ENDIF
+#endif
+                  IF( sn_cfctl%l_oasout ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
                   CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   &
                      &                OASIS_In           , ishape , OASIS_REAL, nerror )
-                  IF ( nerror /= OASIS_Ok ) THEN
+                  IF( nerror /= OASIS_Ok ) THEN
                      WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
                      CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
                   ENDIF
-                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
-                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
+                  IF( sn_cfctl%l_oasout .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
+                  IF( sn_cfctl%l_oasout .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
 
                END DO
@@ -316 +316 @@
 #endif
       !
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi = nldi_save   ;   nlei = nlei_save
          nldj = nldj_save   ;   nlej = nlej_save
@@ -338 +338 @@
       !!--------------------------------------------------------------------
       ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi_save = nldi   ;   nlei_save = nlei
          nldj_save = nldj   ;   nlej_save = nlej
@@ -355 +355 @@
                CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
                
-               IF ( ln_ctl ) THEN        
+               IF ( sn_cfctl%l_oasout ) THEN        
                   IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   &
                      & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN
@@ -374 +374 @@
          ENDDO
       ENDDO
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi = nldi_save   ;   nlei = nlei_save
          nldj = nldj_save   ;   nlej = nlej_save
@@ -399 +399 @@
       !!--------------------------------------------------------------------
       ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi_save = nldi   ;   nlei_save = nlei
          nldj_save = nldj   ;   nlej_save = nlej
@@ -409 +409 @@
       !
       DO jc = 1, srcv(kid)%nct
-         IF ( ltmp_wapatch ) THEN
+         IF( ltmp_wapatch ) THEN
             IF( nimpp           ==      1 ) nldi = 1
             IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi
@@ -426 +426 @@
                   &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
                
-               IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
+               IF ( sn_cfctl%l_oasout )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
                
-               IF ( llaction ) THEN
+               IF( llaction ) THEN
                   
                   kinfo = OASIS_Rcv
@@ -438 +438 @@
                   ENDIF
                   
-                  IF ( ln_ctl ) THEN        
+                  IF ( sn_cfctl%l_oasout ) THEN        
                      WRITE(numout,*) '****************'
                      WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname
@@ -456 +456 @@
          ENDDO
 
-         IF ( ltmp_wapatch ) THEN
+         IF( ltmp_wapatch ) THEN
             nldi = nldi_save   ;   nlei = nlei_save
             nldj = nldj_save   ;   nlej = nlej_save
@@ -489 +489 @@
       !
       DO ji = 1, nsnd
-         IF (ssnd(ji)%laction ) THEN
+         IF(ssnd(ji)%laction ) THEN
             DO jm = 1, ncplmodel
                IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
@@ -501 +501 @@
       ENDDO
       DO ji = 1, nrcv
-         IF (srcv(ji)%laction ) THEN
+         IF(srcv(ji)%laction ) THEN
             DO jm = 1, ncplmodel
                IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
@@ -535 +535 @@
       !
       DEALLOCATE( exfld )
-      IF (nstop == 0) THEN
+      IF(nstop == 0) THEN
          CALL oasis_terminate( nerror )         
       ELSE

NEMO/trunk/src/OCE/SBC/cyclone.F90

@@ -37 +37 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -137 +137 @@
             zhemi = SIGN( 1. , zrlat )
             zinfl = 15.* rad                             ! clim inflow angle in Tropical Cyclones
-         IF ( vortex == 0 ) THEN
+         IF( vortex == 0 ) THEN
 
             ! Vortex Holland reconstruct wind at each lon-lat position
@@ -147 +147 @@
             zb = 2.
 
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-
-                  ! calc distance between TC center and any point following great circle
-                  ! source : http://www.movable-type.co.uk/scripts/latlong.html
-                  zzrglam = rad * glamt(ji,jj) - zrlon
-                  zzrgphi = rad * gphit(ji,jj)
-                  zdist = ra * ACOS(  SIN( zrlat ) * SIN( zzrgphi )   &
-                     &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) )
-
-                 IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius
-                  ! shape of the wind profile
-                  zztmp = ( zrmw / ( zdist + 1.e-12 ) )**zb
-                  zztmp =  zvmax * SQRT( zztmp * EXP(1. - zztmp) )    
-
-                  IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
-                     zztmp = zztmp * ( (zrout2-zdist)*1.e-6 )
-                  ENDIF
-
-                  ! !!! KILL EQ WINDS
-                  ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN
-                  !    zztmp = 0.                              ! winds in other hemisphere
-                  !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
-                  ! ENDIF
-                  ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
-                  !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 
-                  !    !linear to zero between 10 and 5
-                  ! ENDIF
-                  ! !!! / KILL EQ
-
-                  IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
-
-                  zwnd_t =   COS( zinfl ) * zztmp    
-                  zwnd_r = - SIN( zinfl ) * zztmp
-
-                  ! Project radial-tangential components on zonal-meridional components
-                  ! -------------------------------------------------------------------
-                  
-                  ! ztheta = azimuthal angle of the great circle between two points
-                  zztmp = COS( zrlat ) * SIN( zzrgphi ) &
-                     &  - SIN( zrlat ) * COS( zzrgphi ) * COS( zzrglam )
-                  ztheta = ATAN2(        COS( zzrgphi ) * SIN( zzrglam ) , zztmp )
-
-                  zwnd_x(ji,jj) = zwnd_x(ji,jj) - zhemi * COS(ztheta)*zwnd_t + SIN(ztheta)*zwnd_r
-                  zwnd_y(ji,jj) = zwnd_y(ji,jj) + zhemi * SIN(ztheta)*zwnd_t + COS(ztheta)*zwnd_r
-                 ENDIF
-               END DO
-            END DO
+            DO_2D_11_11
+
+               ! calc distance between TC center and any point following great circle
+               ! source : http://www.movable-type.co.uk/scripts/latlong.html
+               zzrglam = rad * glamt(ji,jj) - zrlon
+               zzrgphi = rad * gphit(ji,jj)
+               zdist = ra * ACOS(  SIN( zrlat ) * SIN( zzrgphi )   &
+                  &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) )
+
+              IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius
+               ! shape of the wind profile
+               zztmp = ( zrmw / ( zdist + 1.e-12 ) )**zb
+               zztmp =  zvmax * SQRT( zztmp * EXP(1. - zztmp) )    
+
+               IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
+                  zztmp = zztmp * ( (zrout2-zdist)*1.e-6 )
+               ENDIF
+
+               ! !!! KILL EQ WINDS
+               ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN
+               !    zztmp = 0.                              ! winds in other hemisphere
+               !    IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
+               ! ENDIF
+               ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
+               !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 
+               !    !linear to zero between 10 and 5
+               ! ENDIF
+               ! !!! / KILL EQ
+
+               IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
+
+               zwnd_t =   COS( zinfl ) * zztmp    
+               zwnd_r = - SIN( zinfl ) * zztmp
+
+               ! Project radial-tangential components on zonal-meridional components
+               ! -------------------------------------------------------------------
+               
+               ! ztheta = azimuthal angle of the great circle between two points
+               zztmp = COS( zrlat ) * SIN( zzrgphi ) &
+                  &  - SIN( zrlat ) * COS( zzrgphi ) * COS( zzrglam )
+               ztheta = ATAN2(        COS( zzrgphi ) * SIN( zzrglam ) , zztmp )
+
+               zwnd_x(ji,jj) = zwnd_x(ji,jj) - zhemi * COS(ztheta)*zwnd_t + SIN(ztheta)*zwnd_r
+               zwnd_y(ji,jj) = zwnd_y(ji,jj) + zhemi * SIN(ztheta)*zwnd_t + COS(ztheta)*zwnd_r
+              ENDIF
+            END_2D
          
-         ELSE IF ( vortex == 1 ) THEN
+         ELSE IF( vortex == 1 ) THEN
 
             ! Vortex Willoughby reconstruct wind at each lon-lat position
@@ -206 +204 @@
             zn   =   2.1340 + 0.0077*zvmax - 0.4522*LOG(zrmw/1000.) - 0.0038*ABS( ztct(jtc,jp_lat) )            
             zA   =   0.5913 + 0.0029*zvmax - 0.1361*LOG(zrmw/1000.) - 0.0042*ABS( ztct(jtc,jp_lat) )  
-            IF (zA < 0) THEN 
+            IF(zA < 0) THEN 
                zA=0
             ENDIF           
         
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                                  
-                  zzrglam = rad * glamt(ji,jj) - zrlon
-                  zzrgphi = rad * gphit(ji,jj)
-                  zdist = ra * ACOS(  SIN( zrlat ) * SIN( zzrgphi )   &
-                     &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) )
-
-                 IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius
+            DO_2D_11_11
+                               
+               zzrglam = rad * glamt(ji,jj) - zrlon
+               zzrgphi = rad * gphit(ji,jj)
+               zdist = ra * ACOS(  SIN( zrlat ) * SIN( zzrgphi )   &
+                  &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) )
+
+              IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius
+            
+               ! shape of the wind profile                     
+               IF(zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind
+                  zztmp  = zvmax * (zdist/zrmw)**zn
+               ELSE 
+                  zztmp  = zvmax * ( (1-zA) * EXP(- (zdist-zrmw)/zXX1 ) + zA * EXP(- (zdist-zrmw)/zXX2 ) )
+               ENDIF
+
+               IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
+                  zztmp = zztmp * ( (zrout2-zdist)*1.e-6 )
+               ENDIF
+
+               ! !!! KILL EQ WINDS
+               ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN
+               !    zztmp = 0.                              ! winds in other hemisphere
+               !    IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
+               ! ENDIF
+               ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
+               !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 
+               !    !linear to zero between 10 and 5
+               ! ENDIF
+               ! !!! / KILL EQ
+
+               IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
+
+               zwnd_t =   COS( zinfl ) * zztmp    
+               zwnd_r = - SIN( zinfl ) * zztmp
+
+               ! Project radial-tangential components on zonal-meridional components
+               ! -------------------------------------------------------------------
                
-                  ! shape of the wind profile                     
-                  IF (zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind
-                     zztmp  = zvmax * (zdist/zrmw)**zn
-                  ELSE 
-                     zztmp  = zvmax * ( (1-zA) * EXP(- (zdist-zrmw)/zXX1 ) + zA * EXP(- (zdist-zrmw)/zXX2 ) )
-                  ENDIF
-
-                  IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
-                     zztmp = zztmp * ( (zrout2-zdist)*1.e-6 )
-                  ENDIF
-
-                  ! !!! KILL EQ WINDS
-                  ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN
-                  !    zztmp = 0.                              ! winds in other hemisphere
-                  !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
-                  ! ENDIF
-                  ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
-                  !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 
-                  !    !linear to zero between 10 and 5
-                  ! ENDIF
-                  ! !!! / KILL EQ
-
-                  IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
-
-                  zwnd_t =   COS( zinfl ) * zztmp    
-                  zwnd_r = - SIN( zinfl ) * zztmp
-
-                  ! Project radial-tangential components on zonal-meridional components
-                  ! -------------------------------------------------------------------
-                  
-                  ! ztheta = azimuthal angle of the great circle between two points
-                  zztmp = COS( zrlat ) * SIN( zzrgphi ) &
-                     &  - SIN( zrlat ) * COS( zzrgphi ) * COS( zzrglam )
-                  ztheta = ATAN2(        COS( zzrgphi ) * SIN( zzrglam ) , zztmp )
-
-                  zwnd_x(ji,jj) = zwnd_x(ji,jj) - zhemi * COS(ztheta)*zwnd_t + SIN(ztheta)*zwnd_r
-                  zwnd_y(ji,jj) = zwnd_y(ji,jj) + zhemi * SIN(ztheta)*zwnd_t + COS(ztheta)*zwnd_r
-                  
-                 ENDIF
-               END DO
-            END DO
+               ! ztheta = azimuthal angle of the great circle between two points
+               zztmp = COS( zrlat ) * SIN( zzrgphi ) &
+                  &  - SIN( zrlat ) * COS( zzrgphi ) * COS( zzrglam )
+               ztheta = ATAN2(        COS( zzrgphi ) * SIN( zzrglam ) , zztmp )
+
+               zwnd_x(ji,jj) = zwnd_x(ji,jj) - zhemi * COS(ztheta)*zwnd_t + SIN(ztheta)*zwnd_r
+               zwnd_y(ji,jj) = zwnd_y(ji,jj) + zhemi * SIN(ztheta)*zwnd_t + COS(ztheta)*zwnd_r
+               
+              ENDIF
+            END_2D
          ENDIF                                         ! / vortex Holland or Wiloughby
          ENDIF                                           ! / cyclone is defined in this slot ? yes--> begin

NEMO/trunk/src/OCE/SBC/fldread.F90

@@ -13 +13 @@
    !!   fld_read      : read input fields used for the computation of the surface boundary condition
    !!   fld_init      : initialization of field read
-   !!   fld_rec       : determined the record(s) to be read
+   !!   fld_def       : define the record(s) of the file and its name
    !!   fld_get       : read the data
    !!   fld_map       : read global data from file and map onto local data using a general mapping (use for open boundaries)
    !!   fld_rot       : rotate the vector fields onto the local grid direction
-   !!   fld_clopn     : update the data file name and close/open the files
+   !!   fld_clopn     : close/open the files
    !!   fld_fill      : fill the data structure with the associated information read in namelist
    !!   wgt_list      : manage the weights used for interpolation
@@ -25 +25 @@
    !!   seaoverland   : create shifted matrices for seaoverland application
    !!   fld_interp    : apply weights to input gridded data to create data on model grid
-   !!   ksec_week     : function returning the first 3 letters of the first day of the weekly file
+   !!   fld_filename  : define the filename according to a given date
+   !!   ksec_week     : function returning seconds between 00h of the beginning of the week and half of the current time step
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers
@@ -44 +45 @@
    PUBLIC   fld_map    ! routine called by tides_init
    PUBLIC   fld_read, fld_fill   ! called by sbc... modules
-   PUBLIC   fld_clopn
+   PUBLIC   fld_def
 
    TYPE, PUBLIC ::   FLD_N      !: Namelist field informations
@@ -72 +73 @@
       INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year)
       INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year)
-      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow   ! input fields interpolated to now time step
-      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta   ! 2 consecutive record of input fields
+      INTEGER , ALLOCATABLE, DIMENSION(:      ) ::   nrecsec   ! 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow   ! input fields interpolated to now time step
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta   ! 2 consecutive record of input fields
       CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key
       !                                                 ! into the WGTLIST structure
@@ -118 +120 @@
    TYPE( WGT ), DIMENSION(tot_wgts)   ::   ref_wgts     ! array of wgts
    INTEGER                            ::   nxt_wgt = 1  ! point to next available space in ref_wgts array
+   INTEGER                            ::   nflag = 0
    REAL(wp), PARAMETER                ::   undeff_lsm = -999.00_wp
 
 !$AGRIF_END_DO_NOT_TREAT
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -129 +134 @@
 CONTAINS
 
-   SUBROUTINE fld_read( kt, kn_fsbc, sd, kit, kt_offset )
+   SUBROUTINE fld_read( kt, kn_fsbc, sd, kit, pt_offset, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_read  ***
@@ -145 +150 @@
       TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
       INTEGER  , INTENT(in   ), OPTIONAL     ::   kit       ! subcycle timestep for timesplitting option
-      INTEGER  , INTENT(in   ), OPTIONAL     ::   kt_offset ! provide fields at time other than "now"
-      !                                                     !   kt_offset = -1 => fields at "before" time level
-      !                                                     !   kt_offset = +1 => fields at "after"  time level
-      !                                                     !   etc.
-      !!
-      INTEGER  ::   itmp         ! local variable
+      REAL(wp) , INTENT(in   ), OPTIONAL     ::   pt_offset ! provide fields at time other than "now"
+      INTEGER  , INTENT(in   ), OPTIONAL     ::   Kmm       ! ocean time level index
+      !!
       INTEGER  ::   imf          ! size of the structure sd
       INTEGER  ::   jf           ! dummy indices
-      INTEGER  ::   isecend      ! number of second since Jan. 1st 00h of nit000 year at nitend
       INTEGER  ::   isecsbc      ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step
-      INTEGER  ::   it_offset    ! local time offset variable
-      LOGICAL  ::   llnxtyr      ! open next year  file?
-      LOGICAL  ::   llnxtmth     ! open next month file?
-      LOGICAL  ::   llstop       ! stop is the file does not exist
       LOGICAL  ::   ll_firstcall ! true if this is the first call to fld_read for this set of fields
+      REAL(wp) ::   zt_offset    ! local time offset variable
       REAL(wp) ::   ztinta       ! ratio applied to after  records when doing time interpolation
       REAL(wp) ::   ztintb       ! ratio applied to before records when doing time interpolation
@@ -167 +165 @@
       IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1
 
-      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
-      ELSE                                      ;   it_offset = 0
-      ENDIF
-      IF( PRESENT(kt_offset) )   it_offset = kt_offset
-
-      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
-      IF( present(kit) ) THEN   ! ignore kn_fsbc in this case
-         isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rdt/REAL(nn_baro,wp) )
+      IF( nn_components == jp_iam_sas ) THEN   ;   zt_offset = REAL( nn_fsbc, wp )
+      ELSE                                     ;   zt_offset = 0.
+      ENDIF
+      IF( PRESENT(pt_offset) )   zt_offset = pt_offset
+
+      ! Note that all varibles starting by nsec_* are shifted time by +1/2 time step to be centrered
+      IF( PRESENT(kit) ) THEN   ! ignore kn_fsbc in this case
+         isecsbc = nsec_year + nsec1jan000 + NINT( (     REAL(      kit,wp) + zt_offset ) * rdt / REAL(nn_baro,wp) )
       ELSE                      ! middle of sbc time step
-         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdt) + it_offset * NINT(rdt)
+         ! note: we use kn_fsbc-1 because nsec_year is defined at the middle of the current time step
+         isecsbc = nsec_year + nsec1jan000 + NINT( ( 0.5*REAL(kn_fsbc-1,wp) + zt_offset ) * rdt )
       ENDIF
       imf = SIZE( sd )
@@ -183 +182 @@
          DO jf = 1, imf 
             IF( TRIM(sd(jf)%clrootname) == 'NOT USED' )   CYCLE
-            CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped)
+            CALL fld_init( isecsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped)
          END DO
          IF( lwp ) CALL wgt_print()                ! control print
@@ -192 +191 @@
          !
          DO jf = 1, imf                            ! ---   loop over field   --- !
-
+            !
             IF( TRIM(sd(jf)%clrootname) == 'NOT USED' )   CYCLE
-                      
-            IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN    ! read/update the after data?
-
-               sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:)                                  ! swap before record informations
-               sd(jf)%rotn(1) = sd(jf)%rotn(2)                                      ! swap before rotate informations
-               IF( sd(jf)%ln_tint )   sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! swap before record field
-
-               CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit )    ! update after record informations
-
-               ! if kn_fsbc*rdt is larger than freqh (which is kind of odd),
-               ! it is possible that the before value is no more the good one... we have to re-read it
-               ! if before is not the last record of the file currently opened and after is the first record to be read
-               ! in a new file which means after = 1 (the file to be opened corresponds to the current time)
-               ! or after = nreclast + 1 (the file to be opened corresponds to a future time step)
-               IF( .NOT. ll_firstcall .AND. sd(jf)%ln_tint .AND. sd(jf)%nrec_b(1) /= sd(jf)%nreclast &
-                  &                   .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) == 1 ) THEN
-                  itmp = sd(jf)%nrec_a(1)                       ! temporary storage
-                  sd(jf)%nrec_a(1) = sd(jf)%nreclast            ! read the last record of the file currently opened
-                  CALL fld_get( sd(jf) )                        ! read after data
-                  sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field
-                  sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations
-                  sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - NINT( sd(jf)%freqh * 3600. )  ! assume freq to be in hours in this case
-                  sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations
-                  sd(jf)%nrec_a(1) = itmp                       ! move back to after record 
-               ENDIF
-
-               CALL fld_clopn( sd(jf) )   ! Do we need to open a new year/month/week/day file?
-               
-               IF( sd(jf)%ln_tint ) THEN
-                  
-                  ! if kn_fsbc*rdt is larger than freqh (which is kind of odd),
-                  ! it is possible that the before value is no more the good one... we have to re-read it
-                  ! if before record is not just just before the after record...
-                  IF( .NOT. ll_firstcall .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) /= 1 &
-                     &                   .AND. sd(jf)%nrec_b(1) /= sd(jf)%nrec_a(1) - 1 ) THEN   
-                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - 1       ! move back to before record
-                     CALL fld_get( sd(jf) )                        ! read after data
-                     sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field
-                     sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations
-                     sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - NINT( sd(jf)%freqh * 3600. )  ! assume freq to be in hours in this case
-                     sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations
-                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) + 1       ! move back to after record
-                  ENDIF
-               ENDIF ! temporal interpolation?
-
-               ! do we have to change the year/month/week/day of the forcing field?? 
-               ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current
-               ! one. If so, we are still before the end of the year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1)
-               ! will be larger than the record number that should be read for current year/month/week/day
-               ! do we need next file data?
-               ! This applies to both cases with or without time interpolation
-               IF( sd(jf)%nrec_a(1) > sd(jf)%nreclast ) THEN
-                  
-                  sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - sd(jf)%nreclast   ! 
-                  
-                  IF( .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) ) THEN   ! close/open the current/new file
-                     
-                     llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file?
-                     llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file?
-
-                     ! if the run finishes at the end of the current year/month/week/day, we will allow next
-                     ! year/month/week/day file to be not present. If the run continue further than the current
-                     ! year/month/week/day, next year/month/week/day file must exist
-                     isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdt)   ! second at the end of the run
-                     llstop = isecend > sd(jf)%nrec_a(2)                             ! read more than 1 record of next year
-                     ! we suppose that the date of next file is next day (should be ok even for weekly files...)
-                     CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         &
-                        &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         &
-                        &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop )
-
-                     IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist
-                        CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)//     &
-                           &     ' not present -> back to current year/month/day')
-                        CALL fld_clopn( sd(jf) )               ! back to the current year/month/day
-                        sd(jf)%nrec_a(1) = sd(jf)%nreclast     ! force to read the last record in the current year file
-                     ENDIF
-                     
-                  ENDIF
-               ENDIF   ! open need next file?
-                  
-               ! read after data
-               CALL fld_get( sd(jf) )
-               
-            ENDIF   ! read new data?
+            CALL fld_update( isecsbc, sd(jf), Kmm )
+            !
          END DO                                    ! --- end loop over field --- !
 
@@ -292 +209 @@
                   WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &            
                      & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday
-                  WRITE(numout, *) '      it_offset is : ',it_offset
+                  WRITE(numout, *) '      zt_offset is : ',zt_offset
                ENDIF
                ! temporal interpolation weights
@@ -316 +233 @@
 
 
-   SUBROUTINE fld_init( kn_fsbc, sdjf )
+   SUBROUTINE fld_init( ksecsbc, sdjf )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_init  ***
       !!
-      !! ** Purpose :  - first call to fld_rec to define before values
-      !!               - if time interpolation, read before data 
-      !!----------------------------------------------------------------------
-      INTEGER  , INTENT(in   ) ::   kn_fsbc      ! sbc computation period (in time step) 
+      !! ** Purpose :  - first call(s) to fld_def to define before values
+      !!               - open file
+      !!----------------------------------------------------------------------
+      INTEGER  , INTENT(in   ) ::   ksecsbc   ! 
       TYPE(FLD), INTENT(inout) ::   sdjf         ! input field related variables
-      !!
-      LOGICAL :: llprevyr              ! are we reading previous year  file?
-      LOGICAL :: llprevmth             ! are we reading previous month file?
-      LOGICAL :: llprevweek            ! are we reading previous week  file?
-      LOGICAL :: llprevday             ! are we reading previous day   file?
-      LOGICAL :: llprev                ! llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday
-      INTEGER :: idvar                 ! variable id 
-      INTEGER :: inrec                 ! number of record existing for this variable
-      INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd
-      INTEGER :: isec_week             ! number of seconds since start of the weekly file
-      CHARACTER(LEN=1000) ::   clfmt   ! write format
-      !!---------------------------------------------------------------------
-      !
-      llprevyr   = .FALSE.
-      llprevmth  = .FALSE.
-      llprevweek = .FALSE.
-      llprevday  = .FALSE.
-      isec_week  = 0
-      !
-      ! define record informations
-      CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later)
-      !
-      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
-      !
-      IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure
-         !
-         IF( sdjf%nrec_a(1) == 0  ) THEN   ! we redefine record sdjf%nrec_a(1) with the last record of previous year file
-            IF    ( NINT(sdjf%freqh) == -12 ) THEN   ! yearly mean
-               IF( sdjf%cltype == 'yearly' ) THEN             ! yearly file
-                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record
-                  llprevyr  = .NOT. sdjf%ln_clim                                           ! use previous year  file?
-               ELSE
-                  CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clrootname) )
-               ENDIF
-            ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN   ! monthly mean
-               IF( sdjf%cltype == 'monthly' ) THEN            ! monthly file
-                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record
-                  llprevmth = .TRUE.                                                       ! use previous month file?
-                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
-               ELSE                                           ! yearly file
-                  sdjf%nrec_a(1) = 12                                                      ! force to read december mean
-                  llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
-               ENDIF
-            ELSE                                     ! higher frequency mean (in hours) 
-               IF    ( sdjf%cltype      == 'monthly' ) THEN   ! monthly file
-                  sdjf%nrec_a(1) = NINT( 24. * REAL(nmonth_len(nmonth-1),wp) / sdjf%freqh )! last record of previous month
-                  llprevmth = .TRUE.                                                       ! use previous month file?
-                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
-               ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ! weekly file
-                  llprevweek = .TRUE.                                                      ! use previous week  file?
-                  sdjf%nrec_a(1) = NINT( 24. * 7. / sdjf%freqh )                           ! last record of previous week
-                  isec_week = NINT(rday) * 7                                               ! add a shift toward previous week
-               ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ! daily file
-                  sdjf%nrec_a(1) = NINT( 24. / sdjf%freqh )                                ! last record of previous day
-                  llprevday = .TRUE.                                                       ! use previous day   file?
-                  llprevmth = llprevday .AND. nday   == 1                                  ! use previous month file?
-                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
-               ELSE                                           ! yearly file
-                  sdjf%nrec_a(1) = NINT( 24. * REAL(nyear_len(0),wp) / sdjf%freqh )        ! last record of previous year 
-                  llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
-               ENDIF
-            ENDIF
-         ENDIF
-         !
-         IF ( sdjf%cltype(1:4) == 'week' ) THEN
-            isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week
-            llprevmth = isec_week > nsec_month                      ! longer time since the beginning of the week than the month
-            llprevyr  = llprevmth .AND. nmonth == 1
-         ENDIF
-         llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday
-         !
-         iyear  = nyear  - COUNT((/llprevyr /))
-         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
-         iday   = nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
-         !
-         CALL fld_clopn( sdjf, iyear, imonth, iday, .NOT. llprev )
-         !
-         ! if previous year/month/day file does not exist, we switch to the current year/month/day
-         IF( llprev .AND. sdjf%num <= 0 ) THEN
-            CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clrootname)//   &
-               &           ' not present -> back to current year/month/week/day' )
-            ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day
-            llprev = .FALSE.
-            sdjf%nrec_a(1) = 1
-            CALL fld_clopn( sdjf )
-         ENDIF
-         !
-         IF( llprev ) THEN   ! check if the record sdjf%nrec_a(1) exists in the file
-            idvar = iom_varid( sdjf%num, sdjf%clvar )                                        ! id of the variable sdjf%clvar
-            IF( idvar <= 0 )   RETURN
-            inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar )   ! size of the last dim of idvar
-            sdjf%nrec_a(1) = MIN( sdjf%nrec_a(1), inrec )   ! make sure we select an existing record
-         ENDIF
-         !
-         ! read before data in after arrays(as we will swap it later)
-         CALL fld_get( sdjf )
-         !
-         clfmt = "('   fld_init : time-interpolation for ', a, ' read previous record = ', i6, ' at time = ', f7.2, ' days')"
-         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday
-         !
-      ENDIF
+      !!---------------------------------------------------------------------
+      !
+      IF( nflag == 0 )   nflag = -( HUGE(0) - 10 )
+      !
+      CALL fld_def( sdjf )
+      IF( sdjf%ln_tint .AND. ksecsbc < sdjf%nrecsec(1) )   CALL fld_def( sdjf, ldprev = .TRUE. )
+      !
+      CALL fld_clopn( sdjf )
+      sdjf%nrec_a(:) = (/ 1, nflag /)  ! default definition to force flp_update to read the file.
       !
    END SUBROUTINE fld_init
 
 
-   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, kit, kt_offset )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE fld_rec  ***
+   SUBROUTINE fld_update( ksecsbc, sdjf, Kmm )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_update  ***
       !!
       !! ** Purpose : Compute
@@ -441 +266 @@
       !!                  nrec_b(2) and nrec_a(2): time of the beginning and end of the record
       !!----------------------------------------------------------------------
-      INTEGER  , INTENT(in   )           ::   kn_fsbc   ! sbc computation period (in time step) 
-      TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables
-      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.)
-      INTEGER  , INTENT(in   ), OPTIONAL ::   kit       ! index of barotropic subcycle
-      !                                                 ! used only if sdjf%ln_tint = .TRUE.
-      INTEGER  , INTENT(in   ), OPTIONAL ::   kt_offset ! Offset of required time level compared to "now"
-      !                                                 !   time level in units of time steps.
-      !
-      LOGICAL  ::   llbefore    ! local definition of ldbefore
-      INTEGER  ::   iendrec     ! end of this record (in seconds)
-      INTEGER  ::   imth        ! month number
-      INTEGER  ::   ifreq_sec   ! frequency mean (in seconds)
-      INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file
-      INTEGER  ::   it_offset   ! local time offset variable
-      REAL(wp) ::   ztmp        ! temporary variable
-      !!----------------------------------------------------------------------
-      !
-      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
-      !
-      IF( PRESENT(ldbefore) ) THEN   ;   llbefore = ldbefore .AND. sdjf%ln_tint   ! needed only if sdjf%ln_tint = .TRUE.
-      ELSE                           ;   llbefore = .FALSE.
-      ENDIF
-      !
-      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
-      ELSE                                      ;   it_offset = 0
-      ENDIF
-      IF( PRESENT(kt_offset) )      it_offset = kt_offset
-      IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) )
-      ELSE                      ;   it_offset =         it_offset   * NINT(       rdt            )
-      ENDIF
-      !
-      !                                           ! =========== !
-      IF    ( NINT(sdjf%freqh) == -12 ) THEN      ! yearly mean
-         !                                        ! =========== !
-         !
-         IF( sdjf%ln_tint ) THEN                  ! time interpolation, shift by 1/2 record
-            !
-            !                  INT( ztmp )
-            !                     /|\
-            !                    1 |    *----
-            !                    0 |----(              
-            !                      |----+----|--> time
-            !                      0   /|\   1   (nday/nyear_len(1))
-            !                           |   
-            !                           |   
-            !       forcing record :    1 
-            !                            
-            ztmp =  REAL( nsec_year, wp ) / ( REAL( nyear_len(1), wp ) * rday ) + 0.5 &
-               &  + REAL( it_offset, wp ) / ( REAL( nyear_len(1), wp ) * rday )
-            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
-            ! swap at the middle of the year
-            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(0) + &
-                                    & INT(ztmp) * NINT( 0.5 * rday) * nyear_len(1) 
-            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(1) + &
-                                    & INT(ztmp) * INT(rday) * nyear_len(1) + INT(ztmp) * NINT( 0.5 * rday) * nyear_len(2) 
+      INTEGER  ,           INTENT(in   ) ::   ksecsbc   ! 
+      TYPE(FLD),           INTENT(inout) ::   sdjf      ! input field related variables
+      INTEGER  , OPTIONAL, INTENT(in   ) ::   Kmm    ! ocean time level index
+      !
+      INTEGER  ::   ja     ! end of this record (in seconds)
+      !!----------------------------------------------------------------------
+      !
+      IF( ksecsbc > sdjf%nrec_a(2) ) THEN     ! --> we need to update after data
+        
+         ! find where is the new after record... (it is not necessary sdjf%nrec_a(1)+1 )
+         ja = sdjf%nrec_a(1)
+         DO WHILE ( ksecsbc >= sdjf%nrecsec(ja) .AND. ja < sdjf%nreclast )   ! Warning: make sure ja <= sdjf%nreclast in this test
+            ja = ja + 1
+         END DO
+         IF( ksecsbc > sdjf%nrecsec(ja) )   ja = ja + 1   ! in case ksecsbc > sdjf%nrecsec(sdjf%nreclast)
+
+         ! if ln_tint and if the new after is not ja+1, we need also to update after data before the swap
+         ! so, after the swap, sdjf%nrec_b(2) will still be the closest value located just before ksecsbc
+         IF( sdjf%ln_tint .AND. ( ja > sdjf%nrec_a(1) + 1 .OR. sdjf%nrec_a(2) == nflag ) ) THEN
+            sdjf%nrec_a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /)   ! update nrec_a with before information
+            CALL fld_get( sdjf, Kmm )                         ! read after data that will be used as before data
+         ENDIF
+            
+         ! if after is in the next file...
+         IF( ja > sdjf%nreclast ) THEN
+            
+            CALL fld_def( sdjf )
+            IF( ksecsbc > sdjf%nrecsec(sdjf%nreclast) )   CALL fld_def( sdjf, ldnext = .TRUE. )
+            CALL fld_clopn( sdjf )           ! open next file
+            
+            ! find where is after in this new file
+            ja = 1
+            DO WHILE ( ksecsbc > sdjf%nrecsec(ja) .AND. ja < sdjf%nreclast )
+               ja = ja + 1
+            END DO
+            IF( ksecsbc > sdjf%nrecsec(ja) )   ja = ja + 1   ! in case ksecsbc > sdjf%nrecsec(sdjf%nreclast)
+            
+            IF( ja > sdjf%nreclast ) THEN
+               CALL ctl_stop( "STOP", "fld_def: need next-next file? we should not be there... file: "//TRIM(sdjf%clrootname) )
             ENDIF
-         ELSE                                     ! no time interpolation
-            sdjf%nrec_a(1) = 1
-            sdjf%nrec_a(2) = NINT(rday) * nyear_len(1) + nsec1jan000   ! swap at the end    of the year
-            sdjf%nrec_b(2) = nsec1jan000                               ! beginning of the year (only for print)
-         ENDIF
-         !
-         !                                        ! ============ !
-      ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN      ! monthly mean !
-         !                                        ! ============ !
-         !
-         IF( sdjf%ln_tint ) THEN                  ! time interpolation, shift by 1/2 record
-            !
-            !                  INT( ztmp )
-            !                     /|\
-            !                    1 |    *----
-            !                    0 |----(              
-            !                      |----+----|--> time
-            !                      0   /|\   1   (nday/nmonth_len(nmonth))
-            !                           |   
-            !                           |   
-            !       forcing record :  nmonth 
-            !                            
-            ztmp =  REAL( nsec_month, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) + 0.5 &
-           &      + REAL(  it_offset, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday )
-            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/))
-            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
-            ELSE                                  ;   sdjf%nrec_a(1) = imth
+            
+            ! if ln_tint and if after is not the first record, we must (potentially again) update after data before the swap
+            IF( sdjf%ln_tint .AND. ja > 1 ) THEN
+               IF( sdjf%nrecsec(0) /= nflag ) THEN                  ! no trick used: after file is not the current file
+                  sdjf%nrec_a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /)   ! update nrec_a with before information
+                  CALL fld_get( sdjf, Kmm )                         ! read after data that will be used as before data
+               ENDIF
             ENDIF
-            sdjf%nrec_a(2) = nmonth_half(   imth ) + nsec1jan000   ! swap at the middle of the month
-         ELSE                                    ! no time interpolation
-            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1
-            ELSE                                  ;   sdjf%nrec_a(1) = nmonth
-            ENDIF
-            sdjf%nrec_a(2) =  nmonth_end(nmonth  ) + nsec1jan000   ! swap at the end    of the month
-            sdjf%nrec_b(2) =  nmonth_end(nmonth-1) + nsec1jan000   ! beginning of the month (only for print)
-         ENDIF
-         !
-         !                                        ! ================================ !
-      ELSE                                        ! higher frequency mean (in hours)
-         !                                        ! ================================ !
-         !
-         ifreq_sec = NINT( sdjf%freqh * 3600. )                                         ! frequency mean (in seconds)
-         IF( sdjf%cltype(1:4) == 'week' )   isec_week = ksec_week( sdjf%cltype(6:8) )   ! since the first day of the current week
-         ! number of second since the beginning of the file
-         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)  ! since the first day of the current month
-         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ztmp = REAL(isec_week ,wp)  ! since the first day of the current week
-         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)  ! since 00h of the current day
-         ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year
-         ENDIF
-         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdt + REAL( it_offset, wp )        ! centrered in the middle of sbc time step
-         ztmp = ztmp + 0.01 * rdt                                                       ! avoid truncation error 
-         IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record
-            !
-            !          INT( ztmp/ifreq_sec + 0.5 )
-            !                     /|\
-            !                    2 |        *-----(
-            !                    1 |  *-----(
-            !                    0 |--(              
-            !                      |--+--|--+--|--+--|--> time
-            !                      0 /|\ 1 /|\ 2 /|\ 3    (ztmp/ifreq_sec)
-            !                         |     |     |
-            !                         |     |     |
-            !       forcing record :  1     2     3
-            !                   
-            ztmp= ztmp / REAL(ifreq_sec, wp) + 0.5
-         ELSE                                    ! no time interpolation
-            !
-            !           INT( ztmp/ifreq_sec )
-            !                     /|\
-            !                    2 |           *-----(
-            !                    1 |     *-----(
-            !                    0 |-----(              
-            !                      |--+--|--+--|--+--|--> time
-            !                      0 /|\ 1 /|\ 2 /|\ 3    (ztmp/ifreq_sec)
-            !                         |     |     |
-            !                         |     |     |
-            !       forcing record :  1     2     3
-            !                            
-            ztmp= ztmp / REAL(ifreq_sec, wp)
-         ENDIF
-         sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record number to be read
-
-         iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000       ! end of this record (in second)
-         ! add the number of seconds between 00h Jan 1 and the end of previous month/week/day (ok if nmonth=1)
-         IF( sdjf%cltype      == 'monthly' )   iendrec = iendrec + NINT(rday) * SUM(nmonth_len(1:nmonth -1))
-         IF( sdjf%cltype(1:4) == 'week'    )   iendrec = iendrec + ( nsec_year - isec_week )
-         IF( sdjf%cltype      == 'daily'   )   iendrec = iendrec + NINT(rday) * ( nday_year - 1 )
-         IF( sdjf%ln_tint ) THEN
-             sdjf%nrec_a(2) = iendrec - ifreq_sec / 2        ! swap at the middle of the record
+            
+         ENDIF
+
+         IF( sdjf%ln_tint ) THEN 
+            ! Swap data
+            sdjf%nrec_b(:)     = sdjf%nrec_a(:)                     ! swap before record informations
+            sdjf%rotn(1)       = sdjf%rotn(2)                       ! swap before rotate informations
+            sdjf%fdta(:,:,:,1) = sdjf%fdta(:,:,:,2)                 ! swap before record field
          ELSE
-             sdjf%nrec_a(2) = iendrec                        ! swap at the end    of the record
-             sdjf%nrec_b(2) = iendrec - ifreq_sec            ! beginning of the record (only for print)
-         ENDIF
-         !
-      ENDIF
-      !
-      IF( .NOT. sdjf%ln_tint ) sdjf%nrec_a(2) = sdjf%nrec_a(2) - 1   ! last second belongs to bext record : *----(
-      !
-   END SUBROUTINE fld_rec
-
-
-   SUBROUTINE fld_get( sdjf )
+            sdjf%nrec_b(:) = (/ ja-1, sdjf%nrecsec(ja-1) /)         ! only for print 
+         ENDIF
+            
+         ! read new after data
+         sdjf%nrec_a(:) = (/ ja, sdjf%nrecsec(ja) /)                ! update nrec_a as it is used by fld_get
+         CALL fld_get( sdjf, Kmm )                                  ! read after data (with nrec_a informations)
+        
+      ENDIF
+      !
+   END SUBROUTINE fld_update
+
+
+   SUBROUTINE fld_get( sdjf, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_get  ***
@@ -604 +341 @@
       !! ** Purpose :   read the data
       !!----------------------------------------------------------------------
-      TYPE(FLD)        , INTENT(inout) ::   sdjf   ! input field related variables
+      TYPE(FLD),           INTENT(inout) ::   sdjf   ! input field related variables
+      INTEGER  , OPTIONAL, INTENT(in   ) ::   Kmm    ! ocean time level index
       !
       INTEGER ::   ipk      ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
@@ -618 +356 @@
       IF( ASSOCIATED(sdjf%imap) ) THEN
          IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1),   &
-            &                                        sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint )
+            &                                        sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm )
          ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1),   &
-            &                                        sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint )
+            &                                        sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm )
          ENDIF
       ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
@@ -656 +394 @@
             ENDIF
          CASE DEFAULT
-            IF (lk_c1d .AND. lmoor ) THEN
+            IF(lk_c1d .AND. lmoor ) THEN
                IF( sdjf%ln_tint ) THEN
                   CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) )
@@ -677 +415 @@
 
    
-   SUBROUTINE fld_map( knum, cdvar, pdta, krec, kmap, kgrd, kbdy, ldtotvel, ldzint )
+   SUBROUTINE fld_map( knum, cdvar, pdta, krec, kmap, kgrd, kbdy, ldtotvel, ldzint, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_map  ***
@@ -694 +432 @@
       LOGICAL, OPTIONAL         , INTENT(in   ) ::   ldtotvel     ! true if total ( = barotrop + barocline) velocity
       LOGICAL, OPTIONAL         , INTENT(in   ) ::   ldzint       ! true if 3D variable requires a vertical interpolation
+      INTEGER, OPTIONAL         , INTENT(in   ) ::   Kmm          ! ocean time level index 
       !!
       INTEGER                                   ::   ipi          ! length of boundary data on local process
@@ -758 +497 @@
                
                CALL iom_getatt(knum, '_FillValue', zfv, cdvar=cdvar )
-               CALL fld_bdy_interp(zdta_read, zdta_read_z, zdta_read_dz, pdta, kgrd, kbdy, zfv, ldtotvel)
+               CALL fld_bdy_interp(zdta_read, zdta_read_z, zdta_read_dz, pdta, kgrd, kbdy, zfv, ldtotvel, Kmm)
                DEALLOCATE( zdta_read, zdta_read_z, zdta_read_dz )
                
@@ -822 +561 @@
    END SUBROUTINE fld_map_core
    
-   
-   SUBROUTINE fld_bdy_interp(pdta_read, pdta_read_z, pdta_read_dz, pdta, kgrd, kbdy, pfv, ldtotvel)
+   SUBROUTINE fld_bdy_interp(pdta_read, pdta_read_z, pdta_read_dz, pdta, kgrd, kbdy, pfv, ldtotvel, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_bdy_interp  ***
@@ -840 +578 @@
       INTEGER                   , INTENT(in   ) ::   kgrd            ! grid type (t, u, v)
       INTEGER                   , INTENT(in   ) ::   kbdy            ! bdy number
+      INTEGER, OPTIONAL         , INTENT(in   ) ::   Kmm             ! ocean time level index
       !!
       INTEGER                  ::   ipi                 ! length of boundary data on local process
@@ -866 +605 @@
          SELECT CASE( kgrd )                         
          CASE(1)            ! depth of T points:
-            zdepth(:) = gdept_n(ji,jj,:)
+            zdepth(:) = gdept(ji,jj,:,Kmm)
          CASE(2)            ! depth of U points: we must not use gdept_n as we don't want to do a communication
             !                 --> copy what is done for gdept_n in domvvl...
             zdhalf(1) = 0.0_wp
-            zdepth(1) = 0.5_wp * e3uw_n(ji,jj,1)
+            zdepth(1) = 0.5_wp * e3uw(ji,jj,1,Kmm)
             DO jk = 2, jpk                               ! vertical sum
                !    zcoef = umask - wumask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
@@ -877 +616 @@
                !!gm ???????   BUG ?  gdept_n as well as gde3w_n  does not include the thickness of ISF ??
                zcoef = ( umask(ji,jj,jk) - wumask(ji,jj,jk) )
-               zdhalf(jk) = zdhalf(jk-1) + e3u_n(ji,jj,jk-1)
-               zdepth(jk) =       zcoef  * ( zdhalf(jk  ) + 0.5 * e3uw_n(ji,jj,jk))  &
-                  &         + (1.-zcoef) * ( zdepth(jk-1) +       e3uw_n(ji,jj,jk))
+               zdhalf(jk) = zdhalf(jk-1) + e3u(ji,jj,jk-1,Kmm)
+               zdepth(jk) =          zcoef  * ( zdhalf(jk  ) + 0.5_wp * e3uw(ji,jj,jk,Kmm))  &
+                  &         + (1._wp-zcoef) * ( zdepth(jk-1) +          e3uw(ji,jj,jk,Kmm))
             END DO
          CASE(3)            ! depth of V points: we must not use gdept_n as we don't want to do a communication
             !                 --> copy what is done for gdept_n in domvvl...
             zdhalf(1) = 0.0_wp
-            zdepth(1) = 0.5_wp * e3vw_n(ji,jj,1)
+            zdepth(1) = 0.5_wp * e3vw(ji,jj,1,Kmm)
             DO jk = 2, jpk                               ! vertical sum
                !    zcoef = vmask - wvmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
@@ -891 +630 @@
                !!gm ???????   BUG ?  gdept_n as well as gde3w_n  does not include the thickness of ISF ??
                zcoef = ( vmask(ji,jj,jk) - wvmask(ji,jj,jk) )
-               zdhalf(jk) = zdhalf(jk-1) + e3v_n(ji,jj,jk-1)
-               zdepth(jk) =       zcoef  * ( zdhalf(jk  ) + 0.5 * e3vw_n(ji,jj,jk))  &
-                  &         + (1.-zcoef) * ( zdepth(jk-1) +       e3vw_n(ji,jj,jk))
+               zdhalf(jk) = zdhalf(jk-1) + e3v(ji,jj,jk-1,Kmm)
+               zdepth(jk) =          zcoef  * ( zdhalf(jk  ) + 0.5_wp * e3vw(ji,jj,jk,Kmm))  &
+                  &         + (1._wp-zcoef) * ( zdepth(jk-1) +          e3vw(ji,jj,jk,Kmm))
             END DO
          END SELECT
@@ -911 +650 @@
                END DO
             ENDIF
-         END DO
+         END DO   ! jpk
          !
       END DO   ! ipi
@@ -937 +676 @@
             ztrans_new = 0._wp
             DO jk = 1, jpk                                ! calculate transport on model grid
-               ztrans_new = ztrans_new + pdta(jb,1,jk ) * e3u_n(ji,jj,jk) * umask(ji,jj,jk)
+               ztrans_new = ztrans_new +      pdta(jb,1,jk ) * e3u(ji,jj,jk,Kmm ) * umask(ji,jj,jk)
             ENDDO
             DO jk = 1, jpk                                ! make transport correction
                IF(ldtotvel) THEN ! bdy data are total velocity so adjust bt transport term to match input data
-                  pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hu_n(ji,jj) ) * umask(ji,jj,jk)
+                  pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hu(ji,jj,Kmm) ) * umask(ji,jj,jk)
                ELSE              ! we're just dealing with bc velocity so bt transport term should sum to zero
-                  pdta(jb,1,jk) = ( pdta(jb,1,jk) + (  0._wp - ztrans_new ) * r1_hu_n(ji,jj) ) * umask(ji,jj,jk)
+                  pdta(jb,1,jk) =   pdta(jb,1,jk) + (  0._wp - ztrans_new ) * r1_hu(ji,jj,Kmm)   * umask(ji,jj,jk)
                ENDIF
             ENDDO
@@ -958 +697 @@
             ztrans_new = 0._wp
             DO jk = 1, jpk                                ! calculate transport on model grid
-               ztrans_new = ztrans_new + pdta(jb,1,jk ) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk)
+               ztrans_new = ztrans_new +      pdta(jb,1,jk ) * e3v(ji,jj,jk,Kmm ) * vmask(ji,jj,jk)
             ENDDO
             DO jk = 1, jpk                                ! make transport correction
                IF(ldtotvel) THEN ! bdy data are total velocity so adjust bt transport term to match input data
-                  pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hv_n(ji,jj) ) * vmask(ji,jj,jk)
+                  pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hv(ji,jj,Kmm) ) * vmask(ji,jj,jk)
                ELSE              ! we're just dealing with bc velocity so bt transport term should sum to zero
-                  pdta(jb,1,jk) = ( pdta(jb,1,jk) + (  0._wp - ztrans_new ) * r1_hv_n(ji,jj) ) * vmask(ji,jj,jk)
+                  pdta(jb,1,jk) =   pdta(jb,1,jk) + (  0._wp - ztrans_new ) * r1_hv(ji,jj,Kmm)   * vmask(ji,jj,jk)
                ENDIF
             ENDDO
          ENDDO
       END SELECT
-
+      
    END SUBROUTINE fld_bdy_interp
 
-   
+
    SUBROUTINE fld_rot( kt, sd )
       !!---------------------------------------------------------------------
@@ -1013 +752 @@
                            sd(ju)%fdta(:,:,jk,jn) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,jn) = vtmp(:,:)
                         ELSE 
-                           CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->i', utmp(:,:) )
-                           CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->j', vtmp(:,:) )
+                           CALL rot_rep( sd(ju)%fnow(:,:,jk   ), sd(iv)%fnow(:,:,jk   ), 'T', 'en->i', utmp(:,:) )
+                           CALL rot_rep( sd(ju)%fnow(:,:,jk   ), sd(iv)%fnow(:,:,jk   ), 'T', 'en->j', vtmp(:,:) )
                            sd(ju)%fnow(:,:,jk   ) = utmp(:,:)   ;   sd(iv)%fnow(:,:,jk   ) = vtmp(:,:)
                         ENDIF
@@ -1030 +769 @@
 
 
-   SUBROUTINE fld_clopn( sdjf, kyear, kmonth, kday, ldstop )
+   SUBROUTINE fld_def( sdjf, ldprev, ldnext )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_def  ***
+      !!
+      !! ** Purpose :   define the record(s) of the file and its name
+      !!----------------------------------------------------------------------
+      TYPE(FLD)        , INTENT(inout) ::   sdjf       ! input field related variables
+      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldprev     ! 
+      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldnext     ! 
+      !
+      INTEGER  :: jt
+      INTEGER  :: idaysec               ! number of seconds in 1 day = NINT(rday)
+      INTEGER  :: iyr, imt, idy, isecwk
+      INTEGER  :: indexyr, indexmt
+      INTEGER  :: ireclast
+      INTEGER  :: ishift, istart
+      INTEGER, DIMENSION(2)  :: isave
+      REAL(wp) :: zfreqs
+      LOGICAL  :: llprev, llnext, llstop
+      LOGICAL  :: llprevmt, llprevyr
+      LOGICAL  :: llnextmt, llnextyr
+      !!----------------------------------------------------------------------
+      idaysec = NINT(rday)
+      !
+      IF( PRESENT(ldprev) ) THEN   ;   llprev = ldprev
+      ELSE                         ;   llprev = .FALSE.
+      ENDIF
+      IF( PRESENT(ldnext) ) THEN   ;   llnext = ldnext
+      ELSE                         ;   llnext = .FALSE.
+      ENDIF
+
+      ! current file parameters
+      IF( sdjf%cltype(1:4) == 'week' ) THEN          ! find the day of the beginning of the current week
+         isecwk = ksec_week( sdjf%cltype(6:8) )     ! seconds between the beginning of the week and half of current time step
+         llprevmt = isecwk > nsec_month               ! longer time since beginning of the current week than the current month
+         llprevyr = llprevmt .AND. nmonth == 1
+         iyr = nyear  - COUNT((/llprevyr/))
+         imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/))
+         idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec
+         isecwk = nsec_year - isecwk              ! seconds between 00h jan 1st of current year and current week beginning
+      ELSE
+         iyr = nyear
+         imt = nmonth
+         idy = nday
+         isecwk  = 0
+      ENDIF
+
+      ! previous file parameters
+      IF( llprev ) THEN
+         IF( sdjf%cltype(1:4) == 'week'    ) THEN     ! find the day of the beginning of previous week
+            isecwk = isecwk + 7 * idaysec         ! seconds between the beginning of previous week and half of the time step
+            llprevmt = isecwk > nsec_month            ! longer time since beginning of the previous week than the current month
+            llprevyr = llprevmt .AND. nmonth == 1
+            iyr = nyear  - COUNT((/llprevyr/))
+            imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/))
+            idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec
+            isecwk = nsec_year - isecwk           ! seconds between 00h jan 1st of current year and previous week beginning
+         ELSE
+            idy = nday   - COUNT((/ sdjf%cltype == 'daily'                 /))
+            imt = nmonth - COUNT((/ sdjf%cltype == 'monthly' .OR. idy == 0 /))
+            iyr = nyear  - COUNT((/ sdjf%cltype == 'yearly'  .OR. imt == 0 /))
+            IF( idy == 0 ) idy = nmonth_len(imt)
+            IF( imt == 0 ) imt = 12
+            isecwk = 0
+         ENDIF
+      ENDIF
+
+      ! next file parameters
+      IF( llnext ) THEN
+         IF( sdjf%cltype(1:4) == 'week'    ) THEN     ! find the day of the beginning of next week
+            isecwk = 7 * idaysec - isecwk         ! seconds between half of the time step and the beginning of next week
+            llnextmt = isecwk > ( nmonth_len(nmonth)*idaysec - nsec_month )   ! larger than the seconds to the end of the month
+            llnextyr = llnextmt .AND. nmonth == 12
+            iyr = nyear  + COUNT((/llnextyr/))
+            imt = nmonth + COUNT((/llnextmt/)) - 12 * COUNT((/llnextyr/))
+            idy = nday - nmonth_len(nmonth) * COUNT((/llnextmt/)) + isecwk / idaysec + 1
+            isecwk = nsec_year + isecwk           ! seconds between 00h jan 1st of current year and next week beginning
+         ELSE
+            idy = nday   + COUNT((/ sdjf%cltype == 'daily'                                 /))
+            imt = nmonth + COUNT((/ sdjf%cltype == 'monthly' .OR. idy > nmonth_len(nmonth) /))
+            iyr = nyear  + COUNT((/ sdjf%cltype == 'yearly'  .OR. imt == 13                /))
+            IF( idy > nmonth_len(nmonth) )   idy = 1
+            IF( imt == 13                )   imt = 1
+            isecwk = 0
+         ENDIF
+      ENDIF
+      !
+      ! find the last record to be read -> update sdjf%nreclast
+      indexyr = iyr - nyear + 1                 ! which  year are we looking for? previous(0), current(1) or next(2)?
+      indexmt = imt + 12 * ( indexyr - 1 )      ! which month are we looking for (relatively to current year)? 
+      !
+      ! Last record to be read in the current file
+      ! Predefine the number of record in the file according of its type.
+      ! We could compare this number with the number of records in the file and make a stop if the 2 numbers do not match...
+      ! However this would be much less fexible (e.g. for tests) and will force to rewite input files according to nleapy...
+      IF    ( NINT(sdjf%freqh) == -12 ) THEN            ;   ireclast = 1    ! yearly mean: consider only 1 record
+      ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN                                ! monthly mean:
+         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ireclast = 1    !  consider that the file has  1 record
+         ELSE                                           ;   ireclast = 12   !  consider that the file has 12 record
+         ENDIF
+      ELSE                                                                  ! higher frequency mean (in hours)
+         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ireclast = NINT( 24. * REAL(nmonth_len(indexmt), wp) / sdjf%freqh )
+         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ireclast = NINT( 24. * 7.                            / sdjf%freqh )
+         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ireclast = NINT( 24.                                 / sdjf%freqh )
+         ELSE                                           ;   ireclast = NINT( 24. * REAL( nyear_len(indexyr), wp) / sdjf%freqh )
+         ENDIF
+      ENDIF
+
+      sdjf%nreclast = ireclast
+      ! Allocate arrays for beginning/middle/end of each record (seconds since Jan. 1st 00h of nit000 year)
+      IF( ALLOCATED(sdjf%nrecsec) )   DEALLOCATE( sdjf%nrecsec )
+      ALLOCATE( sdjf%nrecsec( 0:ireclast ) )
+      !
+      IF    ( NINT(sdjf%freqh) == -12 ) THEN                                     ! yearly mean and yearly file
+         SELECT CASE( indexyr )
+         CASE(0)   ;   sdjf%nrecsec(0) = nsec1jan000 - nyear_len( 0 ) * idaysec
+         CASE(1)   ;   sdjf%nrecsec(0) = nsec1jan000
+         CASE(2)   ;   sdjf%nrecsec(0) = nsec1jan000 + nyear_len( 1 ) * idaysec
+         ENDSELECT
+         sdjf%nrecsec(1) = sdjf%nrecsec(0) + nyear_len( indexyr ) * idaysec
+      ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN                                     ! monthly mean:
+         IF(     sdjf%cltype      == 'monthly' ) THEN                            !    monthly file
+            sdjf%nrecsec(0   ) = nsec1jan000 + nmonth_beg(indexmt  )
+            sdjf%nrecsec(1   ) = nsec1jan000 + nmonth_beg(indexmt+1)
+         ELSE                                                                    !    yearly  file
+            ishift = 12 * ( indexyr - 1 )
+            sdjf%nrecsec(0:12) = nsec1jan000 + nmonth_beg(1+ishift:13+ishift)
+         ENDIF
+      ELSE                                                                       ! higher frequency mean (in hours)
+         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   istart = nsec1jan000 + nmonth_beg(indexmt)
+         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   istart = nsec1jan000 + isecwk
+         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   istart = nsec1jan000 + nmonth_beg(indexmt) + ( idy - 1 ) * idaysec
+         ELSEIF( indexyr          == 0         ) THEN   ;   istart = nsec1jan000 - nyear_len( 0 ) * idaysec
+         ELSEIF( indexyr          == 2         ) THEN   ;   istart = nsec1jan000 + nyear_len( 1 ) * idaysec
+         ELSE                                           ;   istart = nsec1jan000
+         ENDIF
+         zfreqs = sdjf%freqh * rhhmm * rmmss
+         DO jt = 0, sdjf%nreclast
+            sdjf%nrecsec(jt) = istart + NINT( zfreqs * REAL(jt,wp) )
+         END DO
+      ENDIF
+      !
+      IF( sdjf%ln_tint ) THEN   ! record time defined in the middle of the record, computed using an implementation
+                                ! of the rounded average that is valid over the full integer range
+         sdjf%nrecsec(1:sdjf%nreclast) = sdjf%nrecsec(0:sdjf%nreclast-1) / 2 + sdjf%nrecsec(1:sdjf%nreclast) / 2 + &
+            & MAX( MOD( sdjf%nrecsec(0:sdjf%nreclast-1), 2 ), MOD( sdjf%nrecsec(1:sdjf%nreclast), 2 ) )
+      END IF
+      !
+      sdjf%clname = fld_filename( sdjf, idy, imt, iyr )
+      !
+   END SUBROUTINE fld_def
+
+   
+   SUBROUTINE fld_clopn( sdjf )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_clopn  ***
       !!
-      !! ** Purpose :   update the file name and close/open the files
-      !!----------------------------------------------------------------------
-      TYPE(FLD)        , INTENT(inout) ::   sdjf     ! input field related variables
-      INTEGER, OPTIONAL, INTENT(in   ) ::   kyear    ! year value
-      INTEGER, OPTIONAL, INTENT(in   ) ::   kmonth   ! month value
-      INTEGER, OPTIONAL, INTENT(in   ) ::   kday     ! day value
-      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
-      !
-      LOGICAL  :: llprevyr              ! are we reading previous year  file?
-      LOGICAL  :: llprevmth             ! are we reading previous month file?
-      INTEGER  :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd
-      INTEGER  :: isec_week             ! number of seconds since start of the weekly file
-      INTEGER  :: indexyr               ! year undex (O/1/2: previous/current/next)
-      REAL(wp) :: zyear_len, zmonth_len ! length (days) of iyear and imonth             ! 
-      CHARACTER(len = 256) ::   clname  ! temporary file name
-      !!----------------------------------------------------------------------
-      IF( PRESENT(kyear) ) THEN                             ! use given values 
-         iyear = kyear
-         imonth = kmonth
-         iday = kday
-         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
-            isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 )  
-            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
-            llprevyr   = llprevmth .AND. nmonth == 1
-            iyear  = nyear  - COUNT((/llprevyr /))
-            imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
-            iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
-         ENDIF
-      ELSE                                                  ! use current day values
-         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
-            isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week
-            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
-            llprevyr   = llprevmth .AND. nmonth == 1
-         ELSE
-            isec_week  = 0
-            llprevmth  = .FALSE.
-            llprevyr   = .FALSE.
-         ENDIF
-         iyear  = nyear  - COUNT((/llprevyr /))
-         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
-         iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
-      ENDIF
-
-      ! build the new filename if not climatological data
-      clname=TRIM(sdjf%clrootname)
-      !
-      ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name
-      IF( .NOT. sdjf%ln_clim ) THEN   
-                                         WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), iyear    ! add year
-         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname          ), imonth   ! add month
-      ELSE
-         ! build the new filename if climatological data
-         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), imonth   ! add month
-      ENDIF
-      IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) &
-            &                            WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname          ), iday     ! add day
-      !
-      IF( TRIM(clname) /= TRIM(sdjf%clname) .OR. sdjf%num == 0 ) THEN   ! new file to be open 
-         !
-         sdjf%clname = TRIM(clname)
-         IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open
-         CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 )
-         !
-         ! find the last record to be read -> update sdjf%nreclast
-         indexyr = iyear - nyear + 1
-         zyear_len = REAL(nyear_len( indexyr ), wp)
-         SELECT CASE ( indexyr )
-         CASE ( 0 )   ;   zmonth_len = 31.   ! previous year -> imonth = 12
-         CASE ( 1 )   ;   zmonth_len = REAL(nmonth_len(imonth), wp)
-         CASE ( 2 )   ;   zmonth_len = 31.   ! next     year -> imonth = 1
-         END SELECT
-         !
-         ! last record to be read in the current file
-         IF    ( sdjf%freqh == -12. ) THEN                 ;   sdjf%nreclast = 1    !  yearly mean
-         ELSEIF( sdjf%freqh ==  -1. ) THEN                                          ! monthly mean
-            IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = 1
-            ELSE                                           ;   sdjf%nreclast = 12
-            ENDIF
-         ELSE                                                                       ! higher frequency mean (in hours)
-            IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = NINT( 24. * zmonth_len / sdjf%freqh )
-            ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   sdjf%nreclast = NINT( 24. * 7.         / sdjf%freqh )
-            ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   sdjf%nreclast = NINT( 24.              / sdjf%freqh )
-            ELSE                                           ;   sdjf%nreclast = NINT( 24. * zyear_len  / sdjf%freqh )
-            ENDIF
-         ENDIF
+      !! ** Purpose :   close/open the files
+      !!----------------------------------------------------------------------
+      TYPE(FLD)        , INTENT(inout) ::   sdjf       ! input field related variables
+      !
+      INTEGER, DIMENSION(2)  :: isave
+      LOGICAL  :: llprev, llnext, llstop
+      !!----------------------------------------------------------------------
+      !
+      llprev = sdjf%nrecsec(sdjf%nreclast) < nsec000_1jan000   ! file ends before the beginning of the job -> file may not exist
+      llnext = sdjf%nrecsec(       0     ) > nsecend_1jan000   ! file begins after the end of the job -> file may not exist 
+
+      llstop = sdjf%ln_clim .OR. .NOT. ( llprev .OR. llnext )
+
+      IF( sdjf%num <= 0 .OR. .NOT. sdjf%ln_clim  ) THEN
+         IF( sdjf%num > 0 )   CALL iom_close( sdjf%num )   ! close file if already open
+         CALL iom_open( sdjf%clname, sdjf%num, ldstop = llstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 )
+      ENDIF
+      !
+      IF( sdjf%num <= 0 .AND. .NOT. llstop ) THEN   ! file not found but we do accept this...
+         !
+         IF( llprev ) THEN   ! previous file does not exist : go back to current and accept to read only the first record
+            CALL ctl_warn('previous file: '//TRIM(sdjf%clname)//' not found -> go back to current year/month/week/day file')
+            isave(1:2) = sdjf%nrecsec(sdjf%nreclast-1:sdjf%nreclast)   ! save previous file info
+            CALL fld_def( sdjf )   ! go back to current file
+            sdjf%nreclast = 1   ! force to use only the first record (do as if other were not existing...)
+            sdjf%nrecsec(0:1) = isave(1:2)
+         ENDIF
+         !
+         IF( llnext ) THEN   ! next     file does not exist : go back to current and accept to read only the last  record 
+            CALL ctl_warn('next file: '//TRIM(sdjf%clname)//' not found -> go back to current year/month/week/day file')
+            isave(1:2) = sdjf%nrecsec(0:1)    ! save next file info
+            CALL fld_def( sdjf )   ! go back to current file
+            ! -> read last record but keep record info from the first record of next file
+            sdjf%nrecsec(sdjf%nreclast-1:sdjf%nreclast) = isave(1:2)
+            sdjf%nrecsec(0:sdjf%nreclast-2) = nflag
+         ENDIF
+         !
+         CALL iom_open( sdjf%clname, sdjf%num, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 )   
          !
       ENDIF
@@ -1300 +1145 @@
       CALL iom_open( sd%clname, inum, ldiof =  LEN(TRIM(sd%wgtname)) > 0 )
 
-      !! get dimensions
-      IF ( SIZE(sd%fnow, 3) > 1 ) THEN
+      !! get dimensions: we consider 2D data as 3D data with vertical dim size = 1
+      IF( SIZE(sd%fnow, 3) > 0 ) THEN
          ALLOCATE( ddims(4) )
       ELSE
@@ -1314 +1159 @@
 
       CALL iom_open ( sd%wgtname, inum )   ! interpolation weights
-      IF ( inum > 0 ) THEN
+      IF( inum > 0 ) THEN
 
          !! determine whether we have an east-west cyclic grid
@@ -1623 +1468 @@
          
          ref_wgts(kw)%fly_dta(:,:,:) = 0.0
-         SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) )
-         CASE(1)
-              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn)
-         CASE DEFAULT
-              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn)
-         END SELECT 
+         CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn)
       ENDIF
       
@@ -1646 +1486 @@
       END DO
 
-      IF (ref_wgts(kw)%numwgt .EQ. 16) THEN
+      IF(ref_wgts(kw)%numwgt .EQ. 16) THEN
 
         !! fix up halo points that we couldnt read from file
@@ -1672 +1512 @@
            IF( jpi1 == 2 ) THEN
               rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap
-              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
-              CASE(1)
-                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
-              CASE DEFAULT
-                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
-              END SELECT      
+              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
               ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:)
            ENDIF
            IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN
               rec1(1) = 1 + ref_wgts(kw)%overlap
-              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
-              CASE(1)
-                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
-              CASE DEFAULT
-                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
-              END SELECT
+              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
               ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:)
            ENDIF
@@ -1729 +1559 @@
          END DO
          !
-      END IF
+      ENDIF
       !
    END SUBROUTINE fld_interp
 
 
+   FUNCTION fld_filename( sdjf, kday, kmonth, kyear )
+      !!---------------------------------------------------------------------
+      !!                    ***  FUNCTION fld_filename *** 
+      !!
+      !! ** Purpose :   define the filename according to a given date
+      !!---------------------------------------------------------------------
+      TYPE(FLD), INTENT(in) ::   sdjf         ! input field related variables
+      INTEGER  , INTENT(in) ::   kday, kmonth, kyear
+      !
+      CHARACTER(len = 256) ::   clname, fld_filename
+      !!---------------------------------------------------------------------
+
+      
+      ! build the new filename if not climatological data
+      clname=TRIM(sdjf%clrootname)
+      !
+      ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name
+      IF( .NOT. sdjf%ln_clim ) THEN   
+                                         WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year
+         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a, "m",i2.2)' ) TRIM( clname          ), kmonth   ! add month
+      ELSE
+         ! build the new filename if climatological data
+         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month
+      ENDIF
+      IF(    sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) &
+         &                               WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname          ), kday     ! add day
+
+      fld_filename = clname
+      
+   END FUNCTION fld_filename
+
+
    FUNCTION ksec_week( cdday )
       !!---------------------------------------------------------------------
-      !!                    ***  FUNCTION kshift_week *** 
-      !!
-      !! ** Purpose :   return the first 3 letters of the first day of the weekly file
+      !!                    ***  FUNCTION ksec_week *** 
+      !!
+      !! ** Purpose :   seconds between 00h of the beginning of the week and half of the current time step
       !!---------------------------------------------------------------------
       CHARACTER(len=*), INTENT(in)   ::   cdday   ! first 3 letters of the first day of the weekly file
@@ -1754 +1616 @@
       ishift = ijul * NINT(rday)
       ! 
-      ksec_week = nsec_week + ishift
+      ksec_week = nsec_monday + ishift
       ksec_week = MOD( ksec_week, 7*NINT(rday) )
       ! 

NEMO/trunk/src/OCE/SBC/geo2ocean.F90

@@ -43 +43 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -160 +160 @@
       ! (computation done on the north stereographic polar plane)
       !
-      DO jj = 2, jpjm1
-         DO ji = fs_2, jpi   ! vector opt.
-            !                  
-            zlam = plamt(ji,jj)     ! north pole direction & modulous (at t-point)
-            zphi = pphit(ji,jj)
-            zxnpt = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
-            zynpt = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
-            znnpt = zxnpt*zxnpt + zynpt*zynpt
-            !
-            zlam = plamu(ji,jj)     ! north pole direction & modulous (at u-point)
-            zphi = pphiu(ji,jj)
-            zxnpu = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
-            zynpu = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
-            znnpu = zxnpu*zxnpu + zynpu*zynpu
-            !
-            zlam = plamv(ji,jj)     ! north pole direction & modulous (at v-point)
-            zphi = pphiv(ji,jj)
-            zxnpv = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
-            zynpv = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
-            znnpv = zxnpv*zxnpv + zynpv*zynpv
-            !
-            zlam = plamf(ji,jj)     ! north pole direction & modulous (at f-point)
-            zphi = pphif(ji,jj)
-            zxnpf = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
-            zynpf = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
-            znnpf = zxnpf*zxnpf + zynpf*zynpf
-            !
-            zlam = plamv(ji,jj  )   ! j-direction: v-point segment direction (around t-point)
-            zphi = pphiv(ji,jj  )
-            zlan = plamv(ji,jj-1)
-            zphh = pphiv(ji,jj-1)
-            zxvvt =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
-               &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
-            zyvvt =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
-               &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
-            znvvt = SQRT( znnpt * ( zxvvt*zxvvt + zyvvt*zyvvt )  )
-            znvvt = MAX( znvvt, 1.e-14 )
-            !
-            zlam = plamf(ji,jj  )   ! j-direction: f-point segment direction (around u-point)
-            zphi = pphif(ji,jj  )
-            zlan = plamf(ji,jj-1)
-            zphh = pphif(ji,jj-1)
-            zxffu =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
-               &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
-            zyffu =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
-               &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
-            znffu = SQRT( znnpu * ( zxffu*zxffu + zyffu*zyffu )  )
-            znffu = MAX( znffu, 1.e-14 )
-            !
-            zlam = plamf(ji  ,jj)   ! i-direction: f-point segment direction (around v-point)
-            zphi = pphif(ji  ,jj)
-            zlan = plamf(ji-1,jj)
-            zphh = pphif(ji-1,jj)
-            zxffv =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
-               &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
-            zyffv =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
-               &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
-            znffv = SQRT( znnpv * ( zxffv*zxffv + zyffv*zyffv )  )
-            znffv = MAX( znffv, 1.e-14 )
-            !
-            zlam = plamu(ji,jj+1)   ! j-direction: u-point segment direction (around f-point)
-            zphi = pphiu(ji,jj+1)
-            zlan = plamu(ji,jj  )
-            zphh = pphiu(ji,jj  )
-            zxuuf =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
-               &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
-            zyuuf =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
-               &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
-            znuuf = SQRT( znnpf * ( zxuuf*zxuuf + zyuuf*zyuuf )  )
-            znuuf = MAX( znuuf, 1.e-14 )
-            !
-            !                       ! cosinus and sinus using dot and cross products
-            gsint(ji,jj) = ( zxnpt*zyvvt - zynpt*zxvvt ) / znvvt
-            gcost(ji,jj) = ( zxnpt*zxvvt + zynpt*zyvvt ) / znvvt
-            !
-            gsinu(ji,jj) = ( zxnpu*zyffu - zynpu*zxffu ) / znffu
-            gcosu(ji,jj) = ( zxnpu*zxffu + zynpu*zyffu ) / znffu
-            !
-            gsinf(ji,jj) = ( zxnpf*zyuuf - zynpf*zxuuf ) / znuuf
-            gcosf(ji,jj) = ( zxnpf*zxuuf + zynpf*zyuuf ) / znuuf
-            !
-            gsinv(ji,jj) = ( zxnpv*zxffv + zynpv*zyffv ) / znffv
-            gcosv(ji,jj) =-( zxnpv*zyffv - zynpv*zxffv ) / znffv     ! (caution, rotation of 90 degres)
-            !
-         END DO
-      END DO
+      DO_2D_00_01
+         !                  
+         zlam = plamt(ji,jj)     ! north pole direction & modulous (at t-point)
+         zphi = pphit(ji,jj)
+         zxnpt = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+         zynpt = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+         znnpt = zxnpt*zxnpt + zynpt*zynpt
+         !
+         zlam = plamu(ji,jj)     ! north pole direction & modulous (at u-point)
+         zphi = pphiu(ji,jj)
+         zxnpu = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+         zynpu = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+         znnpu = zxnpu*zxnpu + zynpu*zynpu
+         !
+         zlam = plamv(ji,jj)     ! north pole direction & modulous (at v-point)
+         zphi = pphiv(ji,jj)
+         zxnpv = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+         zynpv = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+         znnpv = zxnpv*zxnpv + zynpv*zynpv
+         !
+         zlam = plamf(ji,jj)     ! north pole direction & modulous (at f-point)
+         zphi = pphif(ji,jj)
+         zxnpf = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+         zynpf = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+         znnpf = zxnpf*zxnpf + zynpf*zynpf
+         !
+         zlam = plamv(ji,jj  )   ! j-direction: v-point segment direction (around t-point)
+         zphi = pphiv(ji,jj  )
+         zlan = plamv(ji,jj-1)
+         zphh = pphiv(ji,jj-1)
+         zxvvt =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+            &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+         zyvvt =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+            &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+         znvvt = SQRT( znnpt * ( zxvvt*zxvvt + zyvvt*zyvvt )  )
+         znvvt = MAX( znvvt, 1.e-14 )
+         !
+         zlam = plamf(ji,jj  )   ! j-direction: f-point segment direction (around u-point)
+         zphi = pphif(ji,jj  )
+         zlan = plamf(ji,jj-1)
+         zphh = pphif(ji,jj-1)
+         zxffu =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+            &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+         zyffu =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+            &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+         znffu = SQRT( znnpu * ( zxffu*zxffu + zyffu*zyffu )  )
+         znffu = MAX( znffu, 1.e-14 )
+         !
+         zlam = plamf(ji  ,jj)   ! i-direction: f-point segment direction (around v-point)
+         zphi = pphif(ji  ,jj)
+         zlan = plamf(ji-1,jj)
+         zphh = pphif(ji-1,jj)
+         zxffv =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+            &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+         zyffv =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+            &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+         znffv = SQRT( znnpv * ( zxffv*zxffv + zyffv*zyffv )  )
+         znffv = MAX( znffv, 1.e-14 )
+         !
+         zlam = plamu(ji,jj+1)   ! j-direction: u-point segment direction (around f-point)
+         zphi = pphiu(ji,jj+1)
+         zlan = plamu(ji,jj  )
+         zphh = pphiu(ji,jj  )
+         zxuuf =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+            &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+         zyuuf =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+            &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+         znuuf = SQRT( znnpf * ( zxuuf*zxuuf + zyuuf*zyuuf )  )
+         znuuf = MAX( znuuf, 1.e-14 )
+         !
+         !                       ! cosinus and sinus using dot and cross products
+         gsint(ji,jj) = ( zxnpt*zyvvt - zynpt*zxvvt ) / znvvt
+         gcost(ji,jj) = ( zxnpt*zxvvt + zynpt*zyvvt ) / znvvt
+         !
+         gsinu(ji,jj) = ( zxnpu*zyffu - zynpu*zxffu ) / znffu
+         gcosu(ji,jj) = ( zxnpu*zxffu + zynpu*zyffu ) / znffu
+         !
+         gsinf(ji,jj) = ( zxnpf*zyuuf - zynpf*zxuuf ) / znuuf
+         gcosf(ji,jj) = ( zxnpf*zxuuf + zynpf*zyuuf ) / znuuf
+         !
+         gsinv(ji,jj) = ( zxnpv*zxffv + zynpv*zyffv ) / znffv
+         gcosv(ji,jj) =-( zxnpv*zyffv - zynpv*zxffv ) / znffv     ! (caution, rotation of 90 degres)
+         !
+      END_2D
 
       ! =============== !
@@ -251 +249 @@
       ! =============== !
 
-      DO jj = 2, jpjm1
-         DO ji = fs_2, jpi   ! vector opt.
-            IF( MOD( ABS( plamv(ji,jj) - plamv(ji,jj-1) ), 360. ) < 1.e-8 ) THEN
-               gsint(ji,jj) = 0.
-               gcost(ji,jj) = 1.
-            ENDIF
-            IF( MOD( ABS( plamf(ji,jj) - plamf(ji,jj-1) ), 360. ) < 1.e-8 ) THEN
-               gsinu(ji,jj) = 0.
-               gcosu(ji,jj) = 1.
-            ENDIF
-            IF(      ABS( pphif(ji,jj) - pphif(ji-1,jj) )         < 1.e-8 ) THEN
-               gsinv(ji,jj) = 0.
-               gcosv(ji,jj) = 1.
-            ENDIF
-            IF( MOD( ABS( plamu(ji,jj) - plamu(ji,jj+1) ), 360. ) < 1.e-8 ) THEN
-               gsinf(ji,jj) = 0.
-               gcosf(ji,jj) = 1.
-            ENDIF
-         END DO
-      END DO
+      DO_2D_00_01
+         IF( MOD( ABS( plamv(ji,jj) - plamv(ji,jj-1) ), 360. ) < 1.e-8 ) THEN
+            gsint(ji,jj) = 0.
+            gcost(ji,jj) = 1.
+         ENDIF
+         IF( MOD( ABS( plamf(ji,jj) - plamf(ji,jj-1) ), 360. ) < 1.e-8 ) THEN
+            gsinu(ji,jj) = 0.
+            gcosu(ji,jj) = 1.
+         ENDIF
+         IF(      ABS( pphif(ji,jj) - pphif(ji-1,jj) )         < 1.e-8 ) THEN
+            gsinv(ji,jj) = 0.
+            gcosv(ji,jj) = 1.
+         ENDIF
+         IF( MOD( ABS( plamu(ji,jj) - plamu(ji,jj+1) ), 360. ) < 1.e-8 ) THEN
+            gsinf(ji,jj) = 0.
+            gcosf(ji,jj) = 1.
+         ENDIF
+      END_2D
 
       ! =========================== !

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

@@ -2 +2 @@
    !!======================================================================
    !!                       ***  MODULE  sbc_oce  ***
-   !! Surface module :   variables defined in core memory 
+   !! Surface module :   variables defined in core memory
    !!======================================================================
    !! History :  3.0  ! 2006-06  (G. Madec)  Original code
@@ -9 +9 @@
    !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
    !!            3.3  ! 2010-10  (J. Chanut, C. Bricaud)  add the surface pressure forcing
-   !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model 
+   !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model
    !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk)
+   !!            4.0  ! 2019-03  (F. Lemarié, G. Samson) add compatibility with ABL mode
    !!----------------------------------------------------------------------
 
@@ -26 +27 @@
    PUBLIC   sbc_oce_alloc   ! routine called in sbcmod.F90
    PUBLIC   sbc_tau2wnd     ! routine called in several sbc modules
-   
+
    !!----------------------------------------------------------------------
    !!           Namelist for the Ocean Surface Boundary Condition
@@ -34 +35 @@
    LOGICAL , PUBLIC ::   ln_flx         !: flux      formulation
    LOGICAL , PUBLIC ::   ln_blk         !: bulk formulation
+   LOGICAL , PUBLIC ::   ln_abl         !: Atmospheric boundary layer model
 #if defined key_oasis3
    LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used
@@ -43 +45 @@
    LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr)
    LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths
-   LOGICAL , PUBLIC ::   ln_isf         !: ice shelf melting
-   LOGICAL , PUBLIC ::   ln_ssr         !: Sea Surface restoring on SST and/or SSS      
+   LOGICAL , PUBLIC ::   ln_ssr         !: Sea Surface restoring on SST and/or SSS
    LOGICAL , PUBLIC ::   ln_apr_dyn     !: Atmospheric pressure forcing used on dynamics (ocean & ice)
    INTEGER , PUBLIC ::   nn_ice         !: flag for ice in the surface boundary condition (=0/1/2/3)
@@ -50 +51 @@
    !                                             !: =F levitating ice (no presure effect) with mass and salt exchanges
    !                                             !: =T embedded sea-ice (pressure effect + mass and salt exchanges)
-   INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below) 
-   INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget: 
-   !                                             !:  = 0 unchecked 
+   INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below)
+   INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget:
+   !                                             !:  = 0 unchecked
    !                                             !:  = 1 global mean of e-p-r set to zero at each nn_fsbc time step
    !                                             !:  = 2 annual global mean of e-p-r set to zero
@@ -77 +78 @@
    INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation
    INTEGER , PUBLIC, PARAMETER ::   jp_blk     = 3        !: bulk                          formulation
-   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 4        !: Pure ocean-atmosphere Coupled formulation
-   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 5        !: for OPA when doing coupling via SAS module
-   
-   !!----------------------------------------------------------------------
-   !!           Stokes drift parametrization definition 
+   INTEGER , PUBLIC, PARAMETER ::   jp_abl     = 4        !: Atmospheric boundary layer    formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 6        !: for OPA when doing coupling via SAS module
+
+   !!----------------------------------------------------------------------
+   !!           Stokes drift parametrization definition
    !!----------------------------------------------------------------------
    INTEGER , PUBLIC, PARAMETER ::   jp_breivik_2014 = 0     !: Breivik  2014: v_z=v_0*[exp(2*k*z)/(1-8*k*z)]
-   INTEGER , PUBLIC, PARAMETER ::   jp_li_2017      = 1     !: Li et al 2017: Stokes drift based on Phillips spectrum (Breivik 2016) 
-                                                            !  with depth averaged profile
-   INTEGER , PUBLIC, PARAMETER ::   jp_peakfr       = 2     !: Li et al 2017: using the peak wave number read from wave model instead 
-                                                            !  of the inverse depth scale
+   INTEGER , PUBLIC, PARAMETER ::   jp_li_2017      = 1     !: Li et al 2017: Stokes drift based on Phillips spectrum (Breivik 2016)
+   !  with depth averaged profile
+   INTEGER , PUBLIC, PARAMETER ::   jp_peakfr       = 2     !: Li et al 2017: using the peak wave number read from wave model instead
+   !  of the inverse depth scale
    LOGICAL , PUBLIC            ::   ll_st_bv2014  = .FALSE. !  logical indicator, .true. if Breivik 2014 parameterisation is active.
    LOGICAL , PUBLIC            ::   ll_st_li2017  = .FALSE. !  logical indicator, .true. if Li 2017 parameterisation is active.
@@ -96 +98 @@
    !!           component definition
    !!----------------------------------------------------------------------
-   INTEGER , PUBLIC, PARAMETER ::   jp_iam_nemo = 0      !: Initial single executable configuration 
-                                                         !  (no internal OASIS coupling)
+   INTEGER , PUBLIC, PARAMETER ::   jp_iam_nemo = 0      !: Initial single executable configuration
+   !  (no internal OASIS coupling)
    INTEGER , PUBLIC, PARAMETER ::   jp_iam_opa  = 1      !: Multi executable configuration - OPA component
-                                                         !  (internal OASIS coupling)
+   !  (internal OASIS coupling)
    INTEGER , PUBLIC, PARAMETER ::   jp_iam_sas  = 2      !: Multi executable configuration - SAS component
-                                                         !  (internal OASIS coupling)
+   !  (internal OASIS coupling)
    !!----------------------------------------------------------------------
    !!              Ocean Surface Boundary Condition fields
@@ -107 +109 @@
    INTEGER , PUBLIC ::  ncpl_qsr_freq = 0        !: qsr coupling frequency per days from atmosphere (used by top)
    !
-   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress)
    !!                                   !!   now    ! before   !!
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2] 
-   !! wndm is used onmpute surface gases exchanges in ice-free ocean or leads
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2]
+   !! wndm is used compute surface gases exchanges in ice-free ocean or leads
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rhoa              !: air density at "rn_zu" m above the sea       [kg/m3]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2]
@@ -122 +124 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmflx            !: freshwater budget: freezing/melting          [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff        [Kg/m2/s]  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwfisf , fwfisf_b !: ice shelf melting   [Kg/m2/s]  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwficb , fwficb_b !: iceberg melting [Kg/m2/s]  
-
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff                                 [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwficb , fwficb_b !: iceberg melting                              [Kg/m2/s]
    !!
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts
@@ -137 +137 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl)
 
+   !!---------------------------------------------------------------------
+   !! ABL Vertical Domain size
+   !!---------------------------------------------------------------------
+   INTEGER , PUBLIC            ::   jpka   = 2     !: ABL number of vertical levels (default definition)
+   INTEGER , PUBLIC            ::   jpkam1 = 1     !: jpka-1
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ght_abl, ghw_abl          !: ABL geopotential height (needed for iom)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_abl, e3w_abl          !: ABL vertical scale factors (needed for iom)
+
    !!----------------------------------------------------------------------
    !!                     Sea Surface Mean fields
@@ -146 +154 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sss_m     !: mean (nn_fsbc time-step) surface sea salinity            [psu]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tsk_m     !: mean (nn_fsbc time-step) SKIN surface sea temp.      [Celsius]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_m     !: mean (nn_fsbc time-step) sea surface layer thickness       [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-]
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -167 +176 @@
       !
       ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , taum(jpi,jpj) ,     &
-         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) ) 
-         !
+         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , rhoa(jpi,jpj) , STAT=ierr(1) )
+      !
       ALLOCATE( qns_tot(jpi,jpj) , qns  (jpi,jpj) , qns_b(jpi,jpj),        &
          &      qsr_tot(jpi,jpj) , qsr  (jpi,jpj) ,                        &
          &      emp    (jpi,jpj) , emp_b(jpi,jpj) ,                        &
          &      sfx    (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) )
-         !
-      ALLOCATE( fwfisf  (jpi,jpj), rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,  &
-         &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) ,  &
+      !
+      ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,  &
+         &      rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) ,  &
          &      fwficb  (jpi,jpj), fwficb_b(jpi,jpj), STAT=ierr(3) )
-         !
+      !
       ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     &
-         &      atm_co2(jpi,jpj) ,                                        &
+         &      atm_co2(jpi,jpj) , tsk_m(jpi,jpj) ,                       &
          &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      &
          &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) )
-         !
+      !
       ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) )
-         !
+      !
       sbc_oce_alloc = MAXVAL( ierr )
       CALL mpp_sum ( 'sbc_oce', sbc_oce_alloc )
@@ -195 +204 @@
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE sbc_tau2wnd  ***
-      !!                   
-      !! ** Purpose : Estimation of wind speed as a function of wind stress   
+      !!
+      !! ** Purpose : Estimation of wind speed as a function of wind stress
       !!
       !! ** Method  : |tau|=rhoa*Cd*|U|^2
@@ -207 +216 @@
       INTEGER  ::   ji, jj                ! dummy indices
       !!---------------------------------------------------------------------
-      zcoef = 0.5 / ( zrhoa * zcdrag ) 
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
-            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
-            ztau = SQRT( ztx * ztx + zty * zty )
-            wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
-         END DO
-      END DO
+      zcoef = 0.5 / ( zrhoa * zcdrag )
+      DO_2D_00_00
+         ztx = utau(ji-1,jj  ) + utau(ji,jj)
+         zty = vtau(ji  ,jj-1) + vtau(ji,jj)
+         ztau = SQRT( ztx * ztx + zty * zty )
+         wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
+      END_2D
       CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1. )
       !

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

@@ -69 +69 @@
       NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc
       !!----------------------------------------------------------------------
-      REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing
       READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_apr in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namsbc_apr in configuration namelist : File for atmospheric pressure forcing
       READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist' )
@@ -103 +101 @@
       !
       !                                            !* control check
-      IF ( ln_apr_obc  ) THEN
+      IF( ln_apr_obc  ) THEN
          IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data'
       ENDIF

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

@@ -15 +15 @@
    !!            3.7  !  2014-06  (L. Brodeau)  simplification and optimization of CORE bulk
    !!            4.0  !  2016-06  (L. Brodeau)  sbcblk_core becomes sbcblk and is not restricted to the CORE algorithm anymore
-   !!                 !                        ==> based on AeroBulk (http://aerobulk.sourceforge.net/)
+   !!                 !                        ==> based on AeroBulk (https://github.com/brodeau/aerobulk/)
    !!            4.0  !  2016-10  (G. Madec)  introduce a sbc_blk_init routine
-   !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce conduction flux emulator (M. Vancoppenolle) 
+   !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce conduction flux emulator (M. Vancoppenolle)
+   !!            4.0  !  2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE)
    !!----------------------------------------------------------------------
 
@@ -23 +24 @@
    !!   sbc_blk_init  : initialisation of the chosen bulk formulation as ocean surface boundary condition
    !!   sbc_blk       : bulk formulation as ocean surface boundary condition
-   !!   blk_oce       : computes momentum, heat and freshwater fluxes over ocean
-   !!   rho_air       : density of (moist) air (depends on T_air, q_air and SLP
-   !!   cp_air        : specific heat of (moist) air (depends spec. hum. q_air)
-   !!   q_sat         : saturation humidity as a function of SLP and temperature
-   !!   L_vap         : latent heat of vaporization of water as a function of temperature
-   !!             sea-ice case only : 
-   !!   blk_ice_tau   : provide the air-ice stress
-   !!   blk_ice_flx   : provide the heat and mass fluxes at air-ice interface
+   !!   blk_oce_1     : computes pieces of momentum, heat and freshwater fluxes over ocean for ABL model  (ln_abl=TRUE)
+   !!   blk_oce_2     : finalizes momentum, heat and freshwater fluxes computation over ocean after the ABL step  (ln_abl=TRUE)
+   !!             sea-ice case only :
+   !!   blk_ice_1   : provide the air-ice stress
+   !!   blk_ice_2   : provide the heat and mass fluxes at air-ice interface
    !!   blk_ice_qcn   : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux)
    !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag
-   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
+   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers
@@ -46 +44 @@
    USE lib_fortran    ! to use key_nosignedzero
 #if defined key_si3
-   USE ice     , ONLY :   u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif
+   USE ice     , ONLY :   jpl, a_i_b, at_i_b, rn_cnd_s, hfx_err_dif
    USE icethd_dh      ! for CALL ice_thd_snwblow
 #endif
-   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009) 
-   USE sbcblk_algo_coare    ! => turb_coare    : COAREv3.0 (Fairall et al. 2003) 
-   USE sbcblk_algo_coare3p5 ! => turb_coare3p5 : COAREv3.5 (Edson et al. 2013)
-   USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 31) 
+   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009)
+   USE sbcblk_algo_coare3p0 ! => turb_coare3p0 : COAREv3.0 (Fairall et al. 2003)
+   USE sbcblk_algo_coare3p6 ! => turb_coare3p6 : COAREv3.6 (Fairall et al. 2018 + Edson et al. 2013)
+   USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 45r1)
    !
    USE iom            ! I/O manager library
@@ -60 +58 @@
    USE prtctl         ! Print control
 
+   USE sbcblk_phy     ! a catalog of functions for physical/meteorological parameters in the marine boundary layer, rho_air, q_sat, etc...
+
+
    IMPLICIT NONE
    PRIVATE
@@ -65 +66 @@
    PUBLIC   sbc_blk_init  ! called in sbcmod
    PUBLIC   sbc_blk       ! called in sbcmod
+   PUBLIC   blk_oce_1     ! called in sbcabl
+   PUBLIC   blk_oce_2     ! called in sbcabl
 #if defined key_si3
-   PUBLIC   blk_ice_tau   ! routine called in icesbc
-   PUBLIC   blk_ice_flx   ! routine called in icesbc
+   PUBLIC   blk_ice_1     ! routine called in icesbc
+   PUBLIC   blk_ice_2     ! routine called in icesbc
    PUBLIC   blk_ice_qcn   ! routine called in icesbc
-#endif 
-
-!!Lolo: should ultimately be moved in the module with all physical constants ?
-!!gm  : In principle, yes.
-   REAL(wp), PARAMETER ::   Cp_dry = 1005.0       !: Specic heat of dry air, constant pressure      [J/K/kg]
-   REAL(wp), PARAMETER ::   Cp_vap = 1860.0       !: Specic heat of water vapor, constant pressure  [J/K/kg]
-   REAL(wp), PARAMETER ::   R_dry = 287.05_wp     !: Specific gas constant for dry air              [J/K/kg]
-   REAL(wp), PARAMETER ::   R_vap = 461.495_wp    !: Specific gas constant for water vapor          [J/K/kg]
-   REAL(wp), PARAMETER ::   reps0 = R_dry/R_vap   !: ratio of gas constant for dry air and water vapor => ~ 0.622
-   REAL(wp), PARAMETER ::   rctv0 = R_vap/R_dry   !: for virtual temperature (== (1-eps)/eps) => ~ 0.608
-
-   INTEGER , PARAMETER ::   jpfld   =10           ! maximum number of files to read
-   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point
-   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point
-   INTEGER , PARAMETER ::   jp_tair = 3           ! index of 10m air temperature             (Kelvin)
-   INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( % )
-   INTEGER , PARAMETER ::   jp_qsr  = 5           ! index of solar heat                      (W/m2)
-   INTEGER , PARAMETER ::   jp_qlw  = 6           ! index of Long wave                       (W/m2)
-   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s)
-   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s)
-   INTEGER , PARAMETER ::   jp_slp  = 9           ! index of sea level pressure              (Pa)
-   INTEGER , PARAMETER ::   jp_tdif =10           ! index of tau diff associated to HF tau   (N/m2)   at T-point
-
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read)
-
-   !                                             !!! Bulk parameters
-   REAL(wp), PARAMETER ::   cpa    = 1000.5         ! specific heat of air (only used for ice fluxes now...)
-   REAL(wp), PARAMETER ::   Ls     =    2.839e6     ! latent heat of sublimation
-   REAL(wp), PARAMETER ::   Stef   =    5.67e-8     ! Stefan Boltzmann constant
-   REAL(wp), PARAMETER ::   Cd_ice =    1.4e-3      ! transfer coefficient over ice
-   REAL(wp), PARAMETER ::   albo   =    0.066       ! ocean albedo assumed to be constant
-   !
+#endif
+
+   INTEGER , PUBLIC            ::   jpfld         ! maximum number of files to read
+   INTEGER , PUBLIC, PARAMETER ::   jp_wndi = 1   ! index of 10m wind velocity (i-component) (m/s)    at T-point
+   INTEGER , PUBLIC, PARAMETER ::   jp_wndj = 2   ! index of 10m wind velocity (j-component) (m/s)    at T-point
+   INTEGER , PUBLIC, PARAMETER ::   jp_tair = 3   ! index of 10m air temperature             (Kelvin)
+   INTEGER , PUBLIC, PARAMETER ::   jp_humi = 4   ! index of specific humidity               ( % )
+   INTEGER , PUBLIC, PARAMETER ::   jp_qsr  = 5   ! index of solar heat                      (W/m2)
+   INTEGER , PUBLIC, PARAMETER ::   jp_qlw  = 6   ! index of Long wave                       (W/m2)
+   INTEGER , PUBLIC, PARAMETER ::   jp_prec = 7   ! index of total precipitation (rain+snow) (Kg/m2/s)
+   INTEGER , PUBLIC, PARAMETER ::   jp_snow = 8   ! index of snow (solid prcipitation)       (kg/m2/s)
+   INTEGER , PUBLIC, PARAMETER ::   jp_slp  = 9   ! index of sea level pressure              (Pa)
+   INTEGER , PUBLIC, PARAMETER ::   jp_hpgi =10   ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point
+   INTEGER , PUBLIC, PARAMETER ::   jp_hpgj =11   ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point
+
+   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input atmospheric fields (file informations, fields read)
+
    !                           !!* Namelist namsbc_blk : bulk parameters
    LOGICAL  ::   ln_NCAR        ! "NCAR"      algorithm   (Large and Yeager 2008)
    LOGICAL  ::   ln_COARE_3p0   ! "COARE 3.0" algorithm   (Fairall et al. 2003)
-   LOGICAL  ::   ln_COARE_3p5   ! "COARE 3.5" algorithm   (Edson et al. 2013)
-   LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 31)
+   LOGICAL  ::   ln_COARE_3p6   ! "COARE 3.6" algorithm   (Edson et al. 2013)
+   LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 45r1)
    !
-   LOGICAL  ::   ln_taudif      ! logical flag to use the "mean of stress module - module of mean stress" data
-   REAL(wp) ::   rn_pfac        ! multiplication factor for precipitation
-   REAL(wp) ::   rn_efac        ! multiplication factor for evaporation
-   REAL(wp) ::   rn_vfac        ! multiplication factor for ice/ocean velocity in the calculation of wind stress
-   REAL(wp) ::   rn_zqt         ! z(q,t) : height of humidity and temperature measurements
-   REAL(wp) ::   rn_zu          ! z(u)   : height of wind measurements
-!!gm ref namelist initialize it so remove the setting to false below
-   LOGICAL  ::   ln_Cd_L12 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2012)
-   LOGICAL  ::   ln_Cd_L15 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2015)
+   LOGICAL  ::   ln_Cd_L12      ! ice-atm drag = F( ice concentration )                        (Lupkes et al. JGR2012)
+   LOGICAL  ::   ln_Cd_L15      ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015)
    !
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_atm                    ! transfer coefficient for momentum      (tau)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ch_atm                    ! transfer coefficient for sensible heat (Q_sens)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ce_atm                    ! tansfert coefficient for evaporation   (Q_lat)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_zu                      ! air temperature at wind speed height (needed by Lupkes 2015 bulk scheme)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_zu                      ! air spec. hum.  at wind speed height (needed by Lupkes 2015 bulk scheme)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cdn_oce, chn_oce, cen_oce ! needed by Lupkes 2015 bulk scheme
+   REAL(wp)         ::   rn_pfac   ! multiplication factor for precipitation
+   REAL(wp), PUBLIC ::   rn_efac   ! multiplication factor for evaporation
+   REAL(wp), PUBLIC ::   rn_vfac   ! multiplication factor for ice/ocean velocity in the calculation of wind stress
+   REAL(wp)         ::   rn_zqt    ! z(q,t) : height of humidity and temperature measurements
+   REAL(wp)         ::   rn_zu     ! z(u)   : height of wind measurements
+   !
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cd_ice , Ch_ice , Ce_ice   ! transfert coefficients over ice
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cdn_oce, Chn_oce, Cen_oce  ! neutral coeffs over ocean (L15 bulk scheme)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   t_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (L15 bulk scheme)
+
+   LOGICAL  ::   ln_skin_cs     ! use the cool-skin (only available in ECMWF and COARE algorithms) !LB
+   LOGICAL  ::   ln_skin_wl     ! use the warm-layer parameterization (only available in ECMWF and COARE algorithms) !LB
+   LOGICAL  ::   ln_humi_sph    ! humidity read in files ("sn_humi") is specific humidity [kg/kg] if .true. !LB
+   LOGICAL  ::   ln_humi_dpt    ! humidity read in files ("sn_humi") is dew-point temperature [K] if .true. !LB
+   LOGICAL  ::   ln_humi_rlh    ! humidity read in files ("sn_humi") is relative humidity     [%] if .true. !LB
+   !
+   INTEGER  ::   nhumi          ! choice of the bulk algorithm
+   !                            ! associated indices:
+   INTEGER, PARAMETER :: np_humi_sph = 1
+   INTEGER, PARAMETER :: np_humi_dpt = 2
+   INTEGER, PARAMETER :: np_humi_rlh = 3
 
    INTEGER  ::   nblk           ! choice of the bulk algorithm
@@ -128 +124 @@
    INTEGER, PARAMETER ::   np_NCAR      = 1   ! "NCAR" algorithm        (Large and Yeager 2008)
    INTEGER, PARAMETER ::   np_COARE_3p0 = 2   ! "COARE 3.0" algorithm   (Fairall et al. 2003)
-   INTEGER, PARAMETER ::   np_COARE_3p5 = 3   ! "COARE 3.5" algorithm   (Edson et al. 2013)
-   INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 31)
+   INTEGER, PARAMETER ::   np_COARE_3p6 = 3   ! "COARE 3.6" algorithm   (Edson et al. 2013)
+   INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 45r1)
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -144 +140 @@
       !!             ***  ROUTINE sbc_blk_alloc ***
       !!-------------------------------------------------------------------
-      ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), &
-         &      cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), STAT=sbc_blk_alloc )
+      ALLOCATE( t_zu(jpi,jpj)   , q_zu(jpi,jpj)   ,                                      &
+         &      Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj),                    &
+         &      Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), STAT=sbc_blk_alloc )
       !
       CALL mpp_sum ( 'sbcblk', sbc_blk_alloc )
@@ -158 +155 @@
       !! ** Purpose :   choose and initialize a bulk formulae formulation
       !!
-      !! ** Method  : 
+      !! ** Method  :
       !!
       !!----------------------------------------------------------------------
-      INTEGER  ::   ifpr, jfld            ! dummy loop indice and argument
+      INTEGER  ::   jfpr                  ! dummy loop indice and argument
       INTEGER  ::   ios, ierror, ioptio   ! Local integer
       !!
       CHARACTER(len=100)            ::   cn_dir                ! Root directory for location of atmospheric forcing files
-      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read
+      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   slf_i        ! array of namelist informations on the fields to read
       TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read
       TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !       "                        "
-      TYPE(FLD_N) ::   sn_slp , sn_tdif                        !       "                        "
+      TYPE(FLD_N) ::   sn_slp , sn_hpgi, sn_hpgj               !       "                        "
       NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields
-         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif,                &
-         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF,             &   ! bulk algorithm
-         &                 cn_dir , ln_taudif, rn_zqt, rn_zu,                         & 
-         &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15
+         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_hpgi, sn_hpgj,       &
+         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF,             &   ! bulk algorithm
+         &                 cn_dir , rn_zqt, rn_zu,                                    &
+         &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15,           &
+         &                 ln_skin_cs, ln_skin_wl, ln_humi_sph, ln_humi_dpt, ln_humi_rlh  ! cool-skin / warm-layer !LB
       !!---------------------------------------------------------------------
       !
@@ -179 +177 @@
       IF( sbc_blk_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard arrays' )
       !
-      !                             !** read bulk namelist  
-      REWIND( numnam_ref )                !* Namelist namsbc_blk in reference namelist : bulk parameters
+      !                             !** read bulk namelist
       READ  ( numnam_ref, namsbc_blk, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_blk in reference namelist' )
       !
-      REWIND( numnam_cfg )                !* Namelist namsbc_blk in configuration namelist : bulk parameters
       READ  ( numnam_cfg, namsbc_blk, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_blk in configuration namelist' )
@@ -192 +188 @@
       !                             !** initialization of the chosen bulk formulae (+ check)
       !                                   !* select the bulk chosen in the namelist and check the choice
-                                                               ioptio = 0
-      IF( ln_NCAR      ) THEN   ;   nblk =  np_NCAR        ;   ioptio = ioptio + 1   ;   ENDIF
-      IF( ln_COARE_3p0 ) THEN   ;   nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1   ;   ENDIF
-      IF( ln_COARE_3p5 ) THEN   ;   nblk =  np_COARE_3p5   ;   ioptio = ioptio + 1   ;   ENDIF
-      IF( ln_ECMWF     ) THEN   ;   nblk =  np_ECMWF       ;   ioptio = ioptio + 1   ;   ENDIF
-      !
+      ioptio = 0
+      IF( ln_NCAR      ) THEN
+         nblk =  np_NCAR        ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_COARE_3p0 ) THEN
+         nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_COARE_3p6 ) THEN
+         nblk =  np_COARE_3p6   ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_ECMWF     ) THEN
+         nblk =  np_ECMWF       ;   ioptio = ioptio + 1
+      ENDIF
       IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one bulk algorithm' )
+
+      !                             !** initialization of the cool-skin / warm-layer parametrization
+      IF( ln_skin_cs .OR. ln_skin_wl ) THEN
+         !! Some namelist sanity tests:
+         IF( ln_NCAR )      &
+            & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with NCAR algorithm' )
+         IF( nn_fsbc /= 1 ) &
+            & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.')
+      END IF
+
+      IF( ln_skin_wl ) THEN
+         !! Check if the frequency of downwelling solar flux input makes sense and if ln_dm2dc=T if it is daily!
+         IF( (sn_qsr%freqh  < 0.).OR.(sn_qsr%freqh  > 24.) ) &
+            & CALL ctl_stop( 'sbc_blk_init: Warm-layer param. (ln_skin_wl) not compatible with freq. of solar flux > daily' )
+         IF( (sn_qsr%freqh == 24.).AND.(.NOT. ln_dm2dc) ) &
+            & CALL ctl_stop( 'sbc_blk_init: Please set ln_dm2dc=T for warm-layer param. (ln_skin_wl) to work properly' )
+      END IF
+
+      ioptio = 0
+      IF( ln_humi_sph ) THEN
+         nhumi =  np_humi_sph    ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_humi_dpt ) THEN
+         nhumi =  np_humi_dpt    ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_humi_rlh ) THEN
+         nhumi =  np_humi_rlh    ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one type of air humidity' )
       !
       IF( ln_dm2dc ) THEN                 !* check: diurnal cycle on Qsr
          IF( sn_qsr%freqh /= 24. )   CALL ctl_stop( 'sbc_blk_init: ln_dm2dc=T only with daily short-wave input' )
-         IF( sn_qsr%ln_tint ) THEN 
+         IF( sn_qsr%ln_tint ) THEN
             CALL ctl_warn( 'sbc_blk_init: ln_dm2dc=T daily qsr time interpolation done by sbcdcy module',   &
                &           '              ==> We force time interpolation = .false. for qsr' )
@@ -210 +242 @@
       !                                   !* set the bulk structure
       !                                      !- store namelist information in an array
+      IF( ln_blk ) jpfld = 9
+      IF( ln_abl ) jpfld = 11
+      ALLOCATE( slf_i(jpfld) )
+      !
       slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj
       slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw
       slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi
       slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow
-      slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_tdif) = sn_tdif
-      !
-      lhftau = ln_taudif                     !- add an extra field if HF stress is used
-      jfld = jpfld - COUNT( (/.NOT.lhftau/) )
+      slf_i(jp_slp ) = sn_slp
+      IF( ln_abl ) THEN
+         slf_i(jp_hpgi) = sn_hpgi   ;   slf_i(jp_hpgj) = sn_hpgj
+      END IF
       !
       !                                      !- allocate the bulk structure
-      ALLOCATE( sf(jfld), STAT=ierror )
+      ALLOCATE( sf(jpfld), STAT=ierror )
       IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_init: unable to allocate sf structure' )
-      DO ifpr= 1, jfld
-         ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
-         IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
-         IF( slf_i(ifpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(ifpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   &
-            &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   &
-            &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' )
-
+      !
+      DO jfpr= 1, jpfld
+         !
+         IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to zero)
+            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) )
+            sf(jfpr)%fnow(:,:,1) = 0._wp
+         ELSE                                                  !-- used field  --!
+            IF(   ln_abl    .AND.                                                      &
+               &    ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR.   &
+               &      jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair     )  ) THEN   ! ABL: some fields are 3D input
+               ALLOCATE( sf(jfpr)%fnow(jpi,jpj,jpka) )
+               IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,jpka,2) )
+            ELSE                                                                                ! others or Bulk fields are 2D fiels
+               ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) )
+               IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) )
+            ENDIF
+            !
+            IF( slf_i(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(jfpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   &
+               &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   &
+               &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' )
+         ENDIF
       END DO
       !                                      !- fill the bulk structure with namelist informations
       CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' )
       !
-      IF ( ln_wave ) THEN
-      !Activated wave module but neither drag nor stokes drift activated
-         IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN
+      IF( ln_wave ) THEN
+         !Activated wave module but neither drag nor stokes drift activated
+         IF( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN
             CALL ctl_stop( 'STOP',  'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauwoc=F, ln_stcor=F' )
-      !drag coefficient read from wave model definable only with mfs bulk formulae and core 
-         ELSEIF (ln_cdgw .AND. .NOT. ln_NCAR )       THEN       
-             CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae')
-         ELSEIF (ln_stcor .AND. .NOT. ln_sdw)                             THEN
-             CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T')
+            !drag coefficient read from wave model definable only with mfs bulk formulae and core
+         ELSEIF(ln_cdgw .AND. .NOT. ln_NCAR )       THEN
+            CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae')
+         ELSEIF(ln_stcor .AND. .NOT. ln_sdw)                             THEN
+            CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T')
          ENDIF
       ELSE
-      IF ( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                & 
-         &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    &
-         &                  'with drag coefficient (ln_cdgw =T) '  ,                        &
-         &                  'or Stokes Drift (ln_sdw=T) ' ,                                 &
-         &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      &  
-         &                  'or Stokes-Coriolis term (ln_stcori=T)'  )
-      ENDIF 
-      !
-      !           
+         IF( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                &
+            &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    &
+            &                  'with drag coefficient (ln_cdgw =T) '  ,                        &
+            &                  'or Stokes Drift (ln_sdw=T) ' ,                                 &
+            &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      &
+            &                  'or Stokes-Coriolis term (ln_stcori=T)'  )
+      ENDIF
+      !
+      IF( ln_abl ) THEN       ! ABL: read 3D fields for wind, temperature, humidity and pressure gradient
+         rn_zqt = ght_abl(2)          ! set the bulk altitude to ABL first level
+         rn_zu  = ght_abl(2)
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   ABL formulation: overwrite rn_zqt & rn_zu with ABL first level altitude'
+      ENDIF
+      !
+      ! set transfer coefficients to default sea-ice values
+      Cd_ice(:,:) = rCd_ice
+      Ch_ice(:,:) = rCd_ice
+      Ce_ice(:,:) = rCd_ice
+      !
       IF(lwp) THEN                     !** Control print
          !
-         WRITE(numout,*)                  !* namelist 
+         WRITE(numout,*)                  !* namelist
          WRITE(numout,*) '   Namelist namsbc_blk (other than data information):'
          WRITE(numout,*) '      "NCAR"      algorithm   (Large and Yeager 2008)     ln_NCAR      = ', ln_NCAR
          WRITE(numout,*) '      "COARE 3.0" algorithm   (Fairall et al. 2003)       ln_COARE_3p0 = ', ln_COARE_3p0
-         WRITE(numout,*) '      "COARE 3.5" algorithm   (Edson et al. 2013)         ln_COARE_3p5 = ', ln_COARE_3p0
-         WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 31)              ln_ECMWF     = ', ln_ECMWF
-         WRITE(numout,*) '      add High freq.contribution to the stress module     ln_taudif    = ', ln_taudif
+         WRITE(numout,*) '      "COARE 3.6" algorithm (Fairall 2018 + Edson al 2013)ln_COARE_3p6 = ', ln_COARE_3p6
+         WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 45r1)            ln_ECMWF     = ', ln_ECMWF
          WRITE(numout,*) '      Air temperature and humidity reference height (m)   rn_zqt       = ', rn_zqt
          WRITE(numout,*) '      Wind vector reference height (m)                    rn_zu        = ', rn_zu
@@ -275 +335 @@
          CASE( np_NCAR      )   ;   WRITE(numout,*) '   ==>>>   "NCAR" algorithm        (Large and Yeager 2008)'
          CASE( np_COARE_3p0 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.0" algorithm   (Fairall et al. 2003)'
-         CASE( np_COARE_3p5 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.5" algorithm   (Edson et al. 2013)'
-         CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 31)'
+         CASE( np_COARE_3p6 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.6" algorithm (Fairall 2018+Edson et al. 2013)'
+         CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 45r1)'
          END SELECT
          !
+         WRITE(numout,*)
+         WRITE(numout,*) '      use cool-skin  parameterization (SSST)  ln_skin_cs  = ', ln_skin_cs
+         WRITE(numout,*) '      use warm-layer parameterization (SSST)  ln_skin_wl  = ', ln_skin_wl
+         !
+         WRITE(numout,*)
+         SELECT CASE( nhumi )              !* Print the choice of air humidity
+         CASE( np_humi_sph )   ;   WRITE(numout,*) '   ==>>>   air humidity is SPECIFIC HUMIDITY     [kg/kg]'
+         CASE( np_humi_dpt )   ;   WRITE(numout,*) '   ==>>>   air humidity is DEW-POINT TEMPERATURE [K]'
+         CASE( np_humi_rlh )   ;   WRITE(numout,*) '   ==>>>   air humidity is RELATIVE HUMIDITY     [%]'
+         END SELECT
+         !
       ENDIF
       !
@@ -291 +362 @@
       !!              (momentum, heat, freshwater and runoff)
       !!
-      !! ** Method  : (1) READ each fluxes in NetCDF files:
-      !!      the 10m wind velocity (i-component) (m/s)    at T-point
-      !!      the 10m wind velocity (j-component) (m/s)    at T-point
-      !!      the 10m or 2m specific humidity     ( % )
-      !!      the solar heat                      (W/m2)
-      !!      the Long wave                       (W/m2)
-      !!      the 10m or 2m air temperature       (Kelvin)
-      !!      the total precipitation (rain+snow) (Kg/m2/s)
-      !!      the snow (solid prcipitation)       (kg/m2/s)
-      !!      the tau diff associated to HF tau   (N/m2)   at T-point   (ln_taudif=T)
-      !!              (2) CALL blk_oce
+      !! ** Method  :
+      !!              (1) READ each fluxes in NetCDF files:
+      !!      the wind velocity (i-component) at z=rn_zu  (m/s) at T-point
+      !!      the wind velocity (j-component) at z=rn_zu  (m/s) at T-point
+      !!      the specific humidity           at z=rn_zqt (kg/kg)
+      !!      the air temperature             at z=rn_zqt (Kelvin)
+      !!      the solar heat                              (W/m2)
+      !!      the Long wave                               (W/m2)
+      !!      the total precipitation (rain+snow)         (Kg/m2/s)
+      !!      the snow (solid precipitation)              (kg/m2/s)
+      !!      ABL dynamical forcing (i/j-components of either hpg or geostrophic winds)
+      !!              (2) CALL blk_oce_1 and blk_oce_2
       !!
       !!      C A U T I O N : never mask the surface stress fields
@@ -318 +390 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
-      !!---------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zevp
+      REAL(wp) :: ztmp
+      !!----------------------------------------------------------------------
       !
       CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step
-      !
+
+      ! Sanity/consistence test on humidity at first time step to detect potential screw-up:
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*) ''
+#if defined key_agrif
+         IF(lwp) WRITE(numout,*) ' === AGRIF => Sanity/consistence test on air humidity SKIPPED! :( ==='
+#else
+         ztmp = SUM(tmask(:,:,1)) ! number of ocean points on local proc domain
+         IF( ztmp > 8._wp ) THEN ! test only on proc domains with at least 8 ocean points!
+            ztmp = SUM(sf(jp_humi)%fnow(:,:,1)*tmask(:,:,1))/ztmp ! mean humidity over ocean on proc
+            SELECT CASE( nhumi )
+            CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!)
+               IF(  (ztmp < 0._wp) .OR. (ztmp > 0.065)  ) ztmp = -1._wp
+            CASE( np_humi_dpt ) ! dew-point temperature => expect: 110. <= something < 320. [K]
+               IF( (ztmp < 110._wp).OR.(ztmp > 320._wp) ) ztmp = -1._wp
+            CASE( np_humi_rlh ) ! relative humidity => expect: 0. <= something < 100. [%]
+               IF(  (ztmp < 0._wp) .OR.(ztmp > 100._wp) ) ztmp = -1._wp
+            END SELECT
+            IF(ztmp < 0._wp) THEN
+               IF (lwp) WRITE(numout,'("   Mean humidity value found on proc #",i6.6," is: ",f10.5)') narea, ztmp
+               CALL ctl_stop( 'STOP', 'Something is wrong with air humidity!!!', &
+                  &   ' ==> check the unit in your input files'       , &
+                  &   ' ==> check consistence of namelist choice: specific? relative? dew-point?', &
+                  &   ' ==> ln_humi_sph -> [kg/kg] | ln_humi_rlh -> [%] | ln_humi_dpt -> [K] !!!' )
+            END IF
+         END IF
+         IF(lwp) WRITE(numout,*) ' === Sanity/consistence test on air humidity sucessfuly passed! ==='
+#endif
+         IF(lwp) WRITE(numout,*) ''
+      END IF !IF( kt == nit000 )
       !                                            ! compute the surface ocean fluxes using bulk formulea
-      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce( kt, sf, sst_m, ssu_m, ssv_m )
-
+      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+         CALL blk_oce_1( kt, sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   &   !   <<= in
+            &                sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   &   !   <<= in
+            &                sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m,       &   !   <<= in
+            &                sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1),   &   !   <<= in (wl/cs)
+            &                tsk_m, zssq, zcd_du, zsen, zevp )                       !   =>> out
+
+         CALL blk_oce_2(     sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1),   &   !   <<= in
+            &                sf(jp_qlw )%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1),   &   !   <<= in
+            &                sf(jp_snow)%fnow(:,:,1), tsk_m,                     &   !   <<= in
+            &                zsen, zevp )                                            !   <=> in out
+      ENDIF
+      !
 #if defined key_cice
       IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN
          qlw_ice(:,:,1)   = sf(jp_qlw )%fnow(:,:,1)
-         IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )
-         ELSE                ; qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1) 
-         ENDIF 
+         IF( ln_dm2dc ) THEN
+            qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )
+         ELSE
+            qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1)
+         ENDIF
          tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1)
-         qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1)
+
+         SELECT CASE( nhumi )
+         CASE( np_humi_sph )
+            qatm_ice(:,:) =           sf(jp_humi)%fnow(:,:,1)
+         CASE( np_humi_dpt )
+            qatm_ice(:,:) = q_sat(    sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) )
+         CASE( np_humi_rlh )
+            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
+         END SELECT
+
          tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac
          sprecip(:,:)     = sf(jp_snow)%fnow(:,:,1) * rn_pfac
@@ -343 +469 @@
 
 
-   SUBROUTINE blk_oce( kt, sf, pst, pu, pv )
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_oce  ***
-      !!
-      !! ** Purpose :   provide the momentum, heat and freshwater fluxes at
-      !!      the ocean surface at each time step
-      !!
-      !! ** Method  :   bulk formulea for the ocean using atmospheric
-      !!      fields read in sbc_read
+   SUBROUTINE blk_oce_1( kt, pwndi, pwndj , ptair, phumi, &  ! inp
+      &                  pslp , pst   , pu   , pv,        &  ! inp
+      &                  pqsr , pqlw  ,                   &  ! inp
+      &                  ptsk, pssq , pcd_du, psen , pevp   )  ! out
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_oce_1  ***
+      !!
+      !! ** Purpose :   if ln_blk=T, computes surface momentum, heat and freshwater fluxes
+      !!                if ln_abl=T, computes Cd x |U|, Ch x |U|, Ce x |U| for ABL integration
+      !!
+      !! ** Method  :   bulk formulae using atmospheric fields from :
+      !!                if ln_blk=T, atmospheric fields read in sbc_read
+      !!                if ln_abl=T, the ABL model at previous time-step
+      !!
+      !! ** Outputs : - pssq    : surface humidity used to compute latent heat flux (kg/kg)
+      !!              - pcd_du  : Cd x |dU| at T-points  (m/s)
+      !!              - psen    : Ch x |dU| at T-points  (m/s)
+      !!              - pevp    : Ce x |dU| at T-points  (m/s)
+      !!---------------------------------------------------------------------
+      INTEGER , INTENT(in   )                 ::   kt     ! time step index
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndi  ! atmospheric wind at U-point              [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndj  ! atmospheric wind at V-point              [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   phumi  ! specific humidity at T-points            [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   ptair  ! potential temperature at T-points        [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pslp   ! sea-level pressure                       [Pa]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pst    ! surface temperature                      [Celsius]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pu     ! surface current at U-point (i-component) [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pv     ! surface current at V-point (j-component) [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqsr   !
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqlw   !
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   ptsk   ! skin temp. (or SST if CS & WL not used)  [Celsius]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pssq   ! specific humidity at pst                 [kg/kg]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pcd_du ! Cd x |dU| at T-points                    [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   psen   ! Ch x |dU| at T-points                    [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pevp   ! Ce x |dU| at T-points                    [m/s]
+      !
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      REAL(wp) ::   zztmp                ! local variable
+      REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point
+      REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s]
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K]
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqair             ! specific humidity     of air at z=rn_zqt [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_oce           ! momentum transfert coefficient over ocean
+      REAL(wp), DIMENSION(jpi,jpj) ::   zch_oce           ! sensible heat transfert coefficient over ocean
+      REAL(wp), DIMENSION(jpi,jpj) ::   zce_oce           ! latent   heat transfert coefficient over ocean
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat flux
+      REAL(wp), DIMENSION(jpi,jpj) ::   zztmp1, zztmp2
+      !!---------------------------------------------------------------------
+      !
+      ! local scalars ( place there for vector optimisation purposes)
+      !                           ! Temporary conversion from Celcius to Kelvin (and set minimum value far above 0 K)
+      ptsk(:,:) = pst(:,:) + rt0  ! by default: skin temperature = "bulk SST" (will remain this way if NCAR algorithm used!)
+
+      ! ----------------------------------------------------------------------------- !
+      !      0   Wind components and module at T-point relative to the moving ocean   !
+      ! ----------------------------------------------------------------------------- !
+
+      ! ... components ( U10m - U_oce ) at T-point (unmasked)
+#if defined key_cyclone
+      zwnd_i(:,:) = 0._wp
+      zwnd_j(:,:) = 0._wp
+      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012)
+      DO_2D_00_00
+         pwndi(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj)
+         pwndj(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj)
+      END_2D
+#endif
+      DO_2D_00_00
+         zwnd_i(ji,jj) = (  pwndi(ji,jj) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
+         zwnd_j(ji,jj) = (  pwndj(ji,jj) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
+      END_2D
+      CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. )
+      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)
+      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   &
+         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1)
+
+      ! ----------------------------------------------------------------------------- !
+      !      I   Solar FLUX                                                           !
+      ! ----------------------------------------------------------------------------- !
+
+      ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave
+      zztmp = 1. - albo
+      IF( ln_dm2dc ) THEN
+         qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)
+      ELSE
+         qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
+      ENDIF
+
+
+      ! ----------------------------------------------------------------------------- !
+      !     II   Turbulent FLUXES                                                     !
+      ! ----------------------------------------------------------------------------- !
+
+      ! specific humidity at SST
+      pssq(:,:) = rdct_qsat_salt * q_sat( ptsk(:,:), pslp(:,:) )
+
+      IF( ln_skin_cs .OR. ln_skin_wl ) THEN
+         !! Backup "bulk SST" and associated spec. hum.
+         zztmp1(:,:) = ptsk(:,:)
+         zztmp2(:,:) = pssq(:,:)
+      ENDIF
+
+      ! specific humidity of air at "rn_zqt" m above the sea
+      SELECT CASE( nhumi )
+      CASE( np_humi_sph )
+         zqair(:,:) = phumi(:,:)      ! what we read in file is already a spec. humidity!
+      CASE( np_humi_dpt )
+         !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of d_air and slp !' !LBrm
+         zqair(:,:) = q_sat( phumi(:,:), pslp(:,:) )
+      CASE( np_humi_rlh )
+         !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of RH, t_air and slp !' !LBrm
+         zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file
+      END SELECT
+      !
+      ! potential temperature of air at "rn_zqt" m above the sea
+      IF( ln_abl ) THEN
+         ztpot = ptair(:,:)
+      ELSE
+         ! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate
+         !    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2
+         !    (since reanalysis products provide T at z, not theta !)
+         !#LB: because AGRIF hates functions that return something else than a scalar, need to
+         !     use scalar version of gamma_moist() ...
+         DO_2D_11_11
+            ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt
+         END_2D
+      ENDIF
+
+
+
+      !! Time to call the user-selected bulk parameterization for
+      !!  ==  transfer coefficients  ==!   Cd, Ch, Ce at T-point, and more...
+      SELECT CASE( nblk )
+
+      CASE( np_NCAR      )
+         CALL turb_ncar    ( rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm,                              &
+            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
+
+      CASE( np_COARE_3p0 )
+         CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, &
+            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   &
+            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) )
+
+      CASE( np_COARE_3p6 )
+         CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, &
+            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   &
+            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) )
+
+      CASE( np_ECMWF     )
+         CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl,  &
+            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   &
+            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) )
+
+      CASE DEFAULT
+         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' )
+
+      END SELECT
+
+      IF( ln_skin_cs .OR. ln_skin_wl ) THEN
+         !! ptsk and pssq have been updated!!!
+         !!
+         !! In the presence of sea-ice we forget about the cool-skin/warm-layer update of ptsk and pssq:
+         WHERE ( fr_i(:,:) > 0.001_wp )
+            ! sea-ice present, we forget about the update, using what we backed up before call to turb_*()
+            ptsk(:,:) = zztmp1(:,:)
+            pssq(:,:) = zztmp2(:,:)
+         END WHERE
+      END IF
+
+      !!      CALL iom_put( "Cd_oce", zcd_oce)  ! output value of pure ocean-atm. transfer coef.
+      !!      CALL iom_put( "Ch_oce", zch_oce)  ! output value of pure ocean-atm. transfer coef.
+
+      IF( ABS(rn_zu - rn_zqt) < 0.1_wp ) THEN
+         !! If zu == zt, then ensuring once for all that:
+         t_zu(:,:) = ztpot(:,:)
+         q_zu(:,:) = zqair(:,:)
+      ENDIF
+
+
+      !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbcblk_phy.F90
+      ! -------------------------------------------------------------
+
+      IF( ln_abl ) THEN         !==  ABL formulation  ==!   multiplication by rho_air and turbulent fluxes computation done in ablstp
+         !! FL do we need this multiplication by tmask ... ???
+         DO_2D_11_11
+            zztmp = zU_zu(ji,jj) !* tmask(ji,jj,1)
+            wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod
+            pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj)
+            psen(ji,jj)   = zztmp * zch_oce(ji,jj)
+            pevp(ji,jj)   = zztmp * zce_oce(ji,jj)
+         END_2D
+      ELSE                      !==  BLK formulation  ==!   turbulent fluxes computation
+         CALL BULK_FORMULA( rn_zu, ptsk(:,:), pssq(:,:), t_zu(:,:), q_zu(:,:), &
+            &               zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:),         &
+            &               wndm(:,:), zU_zu(:,:), pslp(:,:),                 &
+            &               taum(:,:), psen(:,:), zqla(:,:),                  &
+            &               pEvap=pevp(:,:), prhoa=rhoa(:,:) )
+
+         zqla(:,:) = zqla(:,:) * tmask(:,:,1)
+         psen(:,:) = psen(:,:) * tmask(:,:,1)
+         taum(:,:) = taum(:,:) * tmask(:,:,1)
+         pevp(:,:) = pevp(:,:) * tmask(:,:,1)
+
+         ! Tau i and j component on T-grid points, using array "zcd_oce" as a temporary array...
+         zcd_oce = 0._wp
+         WHERE ( wndm > 0._wp ) zcd_oce = taum / wndm
+         zwnd_i = zcd_oce * zwnd_i
+         zwnd_j = zcd_oce * zwnd_j
+
+         CALL iom_put( "taum_oce", taum )   ! output wind stress module
+
+         ! ... utau, vtau at U- and V_points, resp.
+         !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
+         !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
+         DO_2D_10_10
+            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) &
+               &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))
+            vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) &
+               &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))
+         END_2D
+         CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. )
+
+         IF(sn_cfctl%l_prtctl) THEN
+            CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce_1: wndm   : ')
+            CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce_1: utau   : ', mask1=umask,   &
+               &          tab2d_2=vtau  , clinfo2='            vtau   : ', mask2=vmask )
+         ENDIF
+         !
+      ENDIF !IF( ln_abl )
+      
+      ptsk(:,:) = ( ptsk(:,:) - rt0 ) * tmask(:,:,1)  ! Back to Celsius
+            
+      IF( ln_skin_cs .OR. ln_skin_wl ) THEN
+         CALL iom_put( "t_skin" ,  ptsk        )  ! T_skin in Celsius
+         CALL iom_put( "dt_skin" , ptsk - pst  )  ! T_skin - SST temperature difference...
+      ENDIF
+
+      IF(sn_cfctl%l_prtctl) THEN
+         CALL prt_ctl( tab2d_1=pevp  , clinfo1=' blk_oce_1: pevp   : ' )
+         CALL prt_ctl( tab2d_1=psen  , clinfo1=' blk_oce_1: psen   : ' )
+         CALL prt_ctl( tab2d_1=pssq  , clinfo1=' blk_oce_1: pssq   : ' )
+      ENDIF
+      !
+   END SUBROUTINE blk_oce_1
+
+
+   SUBROUTINE blk_oce_2( ptair, pqsr, pqlw, pprec,   &   ! <<= in
+      &                  psnow, ptsk, psen, pevp     )   ! <<= in
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_oce_2  ***
+      !!
+      !! ** Purpose :   finalize the momentum, heat and freshwater fluxes computation
+      !!                at the ocean surface at each time step knowing Cd, Ch, Ce and
+      !!                atmospheric variables (from ABL or external data)
       !!
       !! ** Outputs : - utau    : i-component of the stress at U-point  (N/m2)
@@ -360 +731 @@
       !!              - qns     : Non Solar heat flux over the ocean    (W/m2)
       !!              - emp     : evaporation minus precipitation       (kg/m2/s)
-      !!
-      !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC
-      !!---------------------------------------------------------------------
-      INTEGER  , INTENT(in   )                 ::   kt    ! time step index
-      TYPE(fld), INTENT(inout), DIMENSION(:)   ::   sf    ! input data
-      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius]
-      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s]
-      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s]
+      !!---------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptair
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqsr
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqlw
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pprec
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psnow
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptsk   ! SKIN surface temperature   [Celsius]
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psen
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pevp
       !
       INTEGER  ::   ji, jj               ! dummy loop indices
-      REAL(wp) ::   zztmp                ! local variable
-      REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point
-      REAL(wp), DIMENSION(jpi,jpj) ::   zsq               ! specific humidity at pst
-      REAL(wp), DIMENSION(jpi,jpj) ::   zqlw, zqsb        ! long wave and sensible heat fluxes
-      REAL(wp), DIMENSION(jpi,jpj) ::   zqla, zevap       ! latent heat fluxes and evaporation
-      REAL(wp), DIMENSION(jpi,jpj) ::   zst               ! surface temperature in Kelvin
-      REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s]
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K]
-      REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa             ! density of air   [kg/m^3]
+      REAL(wp) ::   zztmp,zz1,zz2,zz3    ! local variable
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztskk             ! skin temp. in Kelvin 
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqlw              ! long wave and sensible heat fluxes      
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat fluxes and evaporation
       !!---------------------------------------------------------------------
       !
       ! local scalars ( place there for vector optimisation purposes)
-      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K)
-
+
+
+      ztskk(:,:) = ptsk(:,:) + rt0  ! => ptsk in Kelvin rather than Celsius
+      
       ! ----------------------------------------------------------------------------- !
-      !      0   Wind components and module at T-point relative to the moving ocean   !
+      !     III    Net longwave radiative FLUX                                        !
       ! ----------------------------------------------------------------------------- !
 
-      ! ... components ( U10m - U_oce ) at T-point (unmasked)
-!!gm    move zwnd_i (_j) set to zero  inside the key_cyclone ???
-      zwnd_i(:,:) = 0._wp
-      zwnd_j(:,:) = 0._wp
-#if defined key_cyclone
-      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            sf(jp_wndi)%fnow(ji,jj,1) = sf(jp_wndi)%fnow(ji,jj,1) + zwnd_i(ji,jj)
-            sf(jp_wndj)%fnow(ji,jj,1) = sf(jp_wndj)%fnow(ji,jj,1) + zwnd_j(ji,jj)
-         END DO
-      END DO
-#endif
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
-            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
-         END DO
-      END DO
-      CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. )
-      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)
-      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   &
-         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1)
+      !! LB: now moved after Turbulent fluxes because must use the skin temperature rather that the SST
+      !! (ztskk is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.)
+      zqlw(:,:) = emiss_w * ( pqlw(:,:) - stefan*ztskk(:,:)*ztskk(:,:)*ztskk(:,:)*ztskk(:,:) ) * tmask(:,:,1)   ! Net radiative longwave flux
+
+      !  Latent flux over ocean
+      ! -----------------------
+
+      ! use scalar version of L_vap() for AGRIF compatibility
+      DO_2D_11_11
+         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
+      END_2D
+
+      IF(sn_cfctl%l_prtctl) THEN
+         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce_2: zqla   : ' )
+         CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce_2: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' )
+
+      ENDIF
 
       ! ----------------------------------------------------------------------------- !
-      !      I   Radiative FLUXES                                                     !
+      !     IV    Total FLUXES                                                       !
       ! ----------------------------------------------------------------------------- !
-
-      ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave
-      zztmp = 1. - albo
-      IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)
-      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
-      ENDIF
-
-      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
-
-      ! ----------------------------------------------------------------------------- !
-      !     II    Turbulent FLUXES                                                    !
-      ! ----------------------------------------------------------------------------- !
-
-      ! ... specific humidity at SST and IST tmask(
-      zsq(:,:) = 0.98 * q_sat( zst(:,:), sf(jp_slp)%fnow(:,:,1) )
-      !!
-      !! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate
-      !!    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2
-      !!    (since reanalysis products provide T at z, not theta !)
-      ztpot = sf(jp_tair)%fnow(:,:,1) + gamma_moist( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1) ) * rn_zqt
-
-      SELECT CASE( nblk )        !==  transfer coefficients  ==!   Cd, Ch, Ce at T-point
-      !
-      CASE( np_NCAR      )   ;   CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! NCAR-COREv2
-         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
-      CASE( np_COARE_3p0 )   ;   CALL turb_coare   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.0
-         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
-      CASE( np_COARE_3p5 )   ;   CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.5
-         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
-      CASE( np_ECMWF     )   ;   CALL turb_ecmwf   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! ECMWF
-         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
-      CASE DEFAULT
-         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' )
-      END SELECT
-
-      !                          ! Compute true air density :
-      IF( ABS(rn_zu - rn_zqt) > 0.01 ) THEN     ! At zu: (probably useless to remove zrho*grav*rn_zu from SLP...)
-         zrhoa(:,:) = rho_air( t_zu(:,:)              , q_zu(:,:)              , sf(jp_slp)%fnow(:,:,1) )
-      ELSE                                      ! At zt:
-         zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) )
-      END IF
-
-!!      CALL iom_put( "Cd_oce", Cd_atm)  ! output value of pure ocean-atm. transfer coef.
-!!      CALL iom_put( "Ch_oce", Ch_atm)  ! output value of pure ocean-atm. transfer coef.
-
-      DO jj = 1, jpj             ! tau module, i and j component
-         DO ji = 1, jpi
-            zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd_atm(ji,jj)   ! using bulk wind speed
-            taum  (ji,jj) = zztmp * wndm  (ji,jj)
-            zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj)
-            zwnd_j(ji,jj) = zztmp * zwnd_j(ji,jj)
-         END DO
-      END DO
-
-      !                          ! add the HF tau contribution to the wind stress module
-      IF( lhftau )   taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1)
-
-      CALL iom_put( "taum_oce", taum )   ! output wind stress module
-
-      ! ... utau, vtau at U- and V_points, resp.
-      !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
-      !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
-      DO jj = 1, jpjm1
-         DO ji = 1, fs_jpim1
-            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) &
-               &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))
-            vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) &
-               &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))
-         END DO
-      END DO
-      CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. )
-
-      !  Turbulent fluxes over ocean
-      ! -----------------------------
-
-      ! zqla used as temporary array, for rho*U (common term of bulk formulae):
-      zqla(:,:) = zrhoa(:,:) * zU_zu(:,:) * tmask(:,:,1)
-
-      IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN
-         !! q_air and t_air are given at 10m (wind reference height)
-         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed
-         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - ztpot(:,:)             )   ! Sensible Heat, using bulk wind speed
-      ELSE
-         !! q_air and t_air are not given at 10m (wind reference height)
-         ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!!
-         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - q_zu(:,:) ) ) ! Evaporation, using bulk wind speed
-         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - t_zu(:,:) )   ! Sensible Heat, using bulk wind speed
-      ENDIF
-
-      zqla(:,:) = L_vap(zst(:,:)) * zevap(:,:)     ! Latent Heat flux
-
-
-      IF(ln_ctl) THEN
-         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce: zqla   : ', tab2d_2=Ce_atm , clinfo2=' Ce_oce  : ' )
-         CALL prt_ctl( tab2d_1=zqsb  , clinfo1=' blk_oce: zqsb   : ', tab2d_2=Ch_atm , clinfo2=' Ch_oce  : ' )
-         CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' )
-         CALL prt_ctl( tab2d_1=zsq   , clinfo1=' blk_oce: zsq    : ', tab2d_2=zst, clinfo2=' zst : ' )
-         CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce: utau   : ', mask1=umask,   &
-            &          tab2d_2=vtau  , clinfo2=           ' vtau : ', mask2=vmask )
-         CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce: wndm   : ')
-         CALL prt_ctl( tab2d_1=zst   , clinfo1=' blk_oce: zst    : ')
-      ENDIF
-
-      ! ----------------------------------------------------------------------------- !
-      !     III    Total FLUXES                                                       !
-      ! ----------------------------------------------------------------------------- !
-      !
-      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.)
-         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1)
-      !
-      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar
-         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip
-         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST
-         &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair
-         &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          &
-         &     + sf(jp_snow)%fnow(:,:,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow)
-         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi
+      !
+      emp (:,:) = (  pevp(:,:)                                       &   ! mass flux (evap. - precip.)
+         &         - pprec(:,:) * rn_pfac  ) * tmask(:,:,1)
+      !
+      qns(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                   &   ! Downward Non Solar
+         &     - psnow(:,:) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip
+         &     - pevp(:,:) * ptsk(:,:) * rcp                         &   ! remove evap heat content at SST
+         &     + ( pprec(:,:) - psnow(:,:) ) * rn_pfac               &   ! add liquid precip heat content at Tair
+         &     * ( ptair(:,:) - rt0 ) * rcp                          &
+         &     + psnow(:,:) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow)
+         &     * ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi
       qns(:,:) = qns(:,:) * tmask(:,:,1)
       !
 #if defined key_si3
-      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by SI3)
+      qns_oce(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                             ! non solar without emp (only needed by SI3)
       qsr_oce(:,:) = qsr(:,:)
 #endif
       !
+      CALL iom_put( "rho_air"  , rhoa*tmask(:,:,1) )       ! output air density [kg/m^3]
+      CALL iom_put( "evap_oce" , pevp )                    ! evaporation
+      CALL iom_put( "qlw_oce"  , zqlw )                    ! output downward longwave heat over the ocean
+      CALL iom_put( "qsb_oce"  , psen )                    ! output downward sensible heat over the ocean
+      CALL iom_put( "qla_oce"  , zqla )                    ! output downward latent   heat over the ocean
+      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)   ! output total precipitation [kg/m2/s]
+      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)   ! output solid precipitation [kg/m2/s]
+      CALL iom_put( 'snowpre', sprecip )                   ! Snow
+      CALL iom_put( 'precip' , tprecip )                   ! Total precipitation
+      !
       IF ( nn_ice == 0 ) THEN
-         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave heat over the ocean
-         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible heat over the ocean
-         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent   heat over the ocean
-         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean
-         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean
-         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean
-         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean
-         tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) ! output total precipitation [kg/m2/s]
-         sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) ! output solid precipitation [kg/m2/s]
-         CALL iom_put( 'snowpre', sprecip )                 ! Snow
-         CALL iom_put( 'precip' , tprecip )                 ! Total precipitation
-      ENDIF
-      !
-      IF(ln_ctl) THEN
-         CALL prt_ctl(tab2d_1=zqsb , clinfo1=' blk_oce: zqsb   : ', tab2d_2=zqlw , clinfo2=' zqlw  : ')
-         CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce: zqla   : ', tab2d_2=qsr  , clinfo2=' qsr   : ')
-         CALL prt_ctl(tab2d_1=pst  , clinfo1=' blk_oce: pst    : ', tab2d_2=emp  , clinfo2=' emp   : ')
-         CALL prt_ctl(tab2d_1=utau , clinfo1=' blk_oce: utau   : ', mask1=umask,   &
-            &         tab2d_2=vtau , clinfo2=              ' vtau  : ' , mask2=vmask )
-      ENDIF
-      !
-   END SUBROUTINE blk_oce
-
-
-
-   FUNCTION rho_air( ptak, pqa, pslp )
-      !!-------------------------------------------------------------------------------
-      !!                           ***  FUNCTION rho_air  ***
-      !!
-      !! ** Purpose : compute density of (moist) air using the eq. of state of the atmosphere
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
-      !!-------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak      ! air temperature             [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa       ! air specific humidity   [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp      ! pressure in                [Pa]
-      REAL(wp), DIMENSION(jpi,jpj)             ::   rho_air   ! density of moist air   [kg/m^3]
-      !!-------------------------------------------------------------------------------
-      !
-      rho_air = pslp / (  R_dry*ptak * ( 1._wp + rctv0*pqa )  )
-      !
-   END FUNCTION rho_air
-
-
-   FUNCTION cp_air( pqa )
-      !!-------------------------------------------------------------------------------
-      !!                           ***  FUNCTION cp_air  ***
-      !!
-      !! ** Purpose : Compute specific heat (Cp) of moist air
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!-------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa      ! air specific humidity         [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj)             ::   cp_air   ! specific heat of moist air   [J/K/kg]
-      !!-------------------------------------------------------------------------------
-      !
-      Cp_air = Cp_dry + Cp_vap * pqa
-      !
-   END FUNCTION cp_air
-
-
-   FUNCTION q_sat( ptak, pslp )
-      !!----------------------------------------------------------------------------------
-      !!                           ***  FUNCTION q_sat  ***
-      !!
-      !! ** Purpose : Specific humidity at saturation in [kg/kg]
-      !!              Based on accurate estimate of "e_sat"
-      !!              aka saturation water vapor (Goff, 1957)
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak    ! air temperature                       [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp    ! sea level atmospheric pressure       [Pa]
-      REAL(wp), DIMENSION(jpi,jpj)             ::   q_sat   ! Specific humidity at saturation   [kg/kg]
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      REAL(wp) ::   ze_sat, ztmp   ! local scalar
-      !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            ztmp = rt0 / ptak(ji,jj)
-            !
-            ! Vapour pressure at saturation [hPa] : WMO, (Goff, 1957)
-            ze_sat = 10.**( 10.79574*(1. - ztmp) - 5.028*LOG10(ptak(ji,jj)/rt0)        &
-               &    + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(ptak(ji,jj)/rt0 - 1.)) )  &
-               &    + 0.42873*10.**(-3)*(10.**(4.76955*(1. - ztmp)) - 1.) + 0.78614  )
-               !
-            q_sat(ji,jj) = reps0 * ze_sat/( 0.01_wp*pslp(ji,jj) - (1._wp - reps0)*ze_sat )   ! 0.01 because SLP is in [Pa]
-            !
-         END DO
-      END DO
-      !
-   END FUNCTION q_sat
-
-
-   FUNCTION gamma_moist( ptak, pqa )
-      !!----------------------------------------------------------------------------------
-      !!                           ***  FUNCTION gamma_moist  ***
-      !!
-      !! ** Purpose : Compute the moist adiabatic lapse-rate.
-      !!     => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate
-      !!     => http://www.geog.ucsb.edu/~joel/g266_s10/lecture_notes/chapt03/oh10_3_01/oh10_3_01.html
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak          ! air temperature       [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa           ! specific humidity [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj)             ::   gamma_moist   ! moist adiabatic lapse-rate
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      REAL(wp) :: zrv, ziRT        ! local scalar
-      !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zrv = pqa(ji,jj) / (1. - pqa(ji,jj))
-            ziRT = 1. / (R_dry*ptak(ji,jj))    ! 1/RT
-            gamma_moist(ji,jj) = grav * ( 1. + rLevap*zrv*ziRT ) / ( Cp_dry + rLevap*rLevap*zrv*reps0*ziRT/ptak(ji,jj) )
-         END DO
-      END DO
-      !
-   END FUNCTION gamma_moist
-
-
-   FUNCTION L_vap( psst )
-      !!---------------------------------------------------------------------------------
-      !!                           ***  FUNCTION L_vap  ***
-      !!
-      !! ** Purpose : Compute the latent heat of vaporization of water from temperature
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj)             ::   L_vap   ! latent heat of vaporization   [J/kg]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   psst   ! water temperature                [K]
-      !!----------------------------------------------------------------------------------
-      !
-      L_vap = (  2.501 - 0.00237 * ( psst(:,:) - rt0)  ) * 1.e6
-      !
-   END FUNCTION L_vap
+         CALL iom_put( "qemp_oce" , qns-zqlw-psen-zqla )   ! output downward heat content of E-P over the ocean
+         CALL iom_put( "qns_oce"  ,   qns  )               ! output downward non solar heat over the ocean
+         CALL iom_put( "qsr_oce"  ,   qsr  )               ! output downward solar heat over the ocean
+         CALL iom_put( "qt_oce"   ,   qns+qsr )            ! output total downward heat over the ocean
+      ENDIF
+      !
+      IF(sn_cfctl%l_prtctl) THEN
+         CALL prt_ctl(tab2d_1=zqlw , clinfo1=' blk_oce_2: zqlw  : ')
+         CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce_2: zqla  : ', tab2d_2=qsr  , clinfo2=' qsr   : ')
+         CALL prt_ctl(tab2d_1=emp  , clinfo1=' blk_oce_2: emp   : ')
+      ENDIF
+      !
+   END SUBROUTINE blk_oce_2
+
 
 #if defined key_si3
@@ -686 +826 @@
    !!   'key_si3'                                       SI3 sea-ice model
    !!----------------------------------------------------------------------
-   !!   blk_ice_tau : provide the air-ice stress
-   !!   blk_ice_flx : provide the heat and mass fluxes at air-ice interface
+   !!   blk_ice_1   : provide the air-ice stress
+   !!   blk_ice_2   : provide the heat and mass fluxes at air-ice interface
    !!   blk_ice_qcn : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux)
    !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag
-   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
+   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag
    !!----------------------------------------------------------------------
 
-   SUBROUTINE blk_ice_tau
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_ice_tau  ***
+   SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, phumi, pslp , puice, pvice, ptsui,  &   ! inputs
+      &                  putaui, pvtaui, pseni, pevpi, pssqi, pcd_dui             )   ! optional outputs
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_1  ***
       !!
       !! ** Purpose :   provide the surface boundary condition over sea-ice
@@ -703 +844 @@
       !!                NB: ice drag coefficient is assumed to be a constant
       !!---------------------------------------------------------------------
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pslp    ! sea-level pressure [Pa]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndi   ! atmospheric wind at T-point [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndj   ! atmospheric wind at T-point [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptair   ! atmospheric wind at T-point [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   phumi   ! atmospheric wind at T-point [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   puice   ! sea-ice velocity on I or C grid [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pvice   ! "
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptsui   ! sea-ice surface temperature [K]
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   putaui  ! if ln_blk
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pvtaui  ! if ln_blk
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pseni   ! if ln_abl
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pevpi   ! if ln_abl
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pssqi   ! if ln_abl
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pcd_dui ! if ln_abl
+      !
       INTEGER  ::   ji, jj    ! dummy loop indices
-      REAL(wp) ::   zwndi_f , zwndj_f, zwnorm_f   ! relative wind module and components at F-point
       REAL(wp) ::   zwndi_t , zwndj_t             ! relative wind components at T-point
-      REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa     ! transfer coefficient for momentum      (tau)
-      !!---------------------------------------------------------------------
-      !
-      ! set transfer coefficients to default sea-ice values
-      Cd_atm(:,:) = Cd_ice
-      Ch_atm(:,:) = Cd_ice
-      Ce_atm(:,:) = Cd_ice
-
-      wndm_ice(:,:) = 0._wp      !!gm brutal....
+      REAL(wp) ::   zootm_su                      ! sea-ice surface mean temperature
+      REAL(wp) ::   zztmp1, zztmp2                ! temporary arrays
+      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_dui   ! transfer coefficient for momentum      (tau)
+      !!---------------------------------------------------------------------
+      !
 
       ! ------------------------------------------------------------ !
@@ -720 +871 @@
       ! ------------------------------------------------------------ !
       ! C-grid ice dynamics :   U & V-points (same as ocean)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  )
-            zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  )
-            wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_00_00
+         zwndi_t = (  pwndi(ji,jj) - rn_vfac * 0.5_wp * ( puice(ji-1,jj  ) + puice(ji,jj) )  )
+         zwndj_t = (  pwndj(ji,jj) - rn_vfac * 0.5_wp * ( pvice(ji  ,jj-1) + pvice(ji,jj) )  )
+         wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+      END_2D
       CALL lbc_lnk( 'sbcblk', wndm_ice, 'T',  1. )
       !
       ! Make ice-atm. drag dependent on ice concentration
       IF    ( ln_Cd_L12 ) THEN   ! calculate new drag from Lupkes(2012) equations
-         CALL Cdn10_Lupkes2012( Cd_atm )
-         Ch_atm(:,:) = Cd_atm(:,:)       ! momentum and heat transfer coef. are considered identical
+         CALL Cdn10_Lupkes2012( Cd_ice )
+         Ch_ice(:,:) = Cd_ice(:,:)       ! momentum and heat transfer coef. are considered identical
+         Ce_ice(:,:) = Cd_ice(:,:)
       ELSEIF( ln_Cd_L15 ) THEN   ! calculate new drag from Lupkes(2015) equations
-         CALL Cdn10_Lupkes2015( Cd_atm, Ch_atm ) 
-      ENDIF
-
-!!      CALL iom_put( "Cd_ice", Cd_atm)  ! output value of pure ice-atm. transfer coef.
-!!      CALL iom_put( "Ch_ice", Ch_atm)  ! output value of pure ice-atm. transfer coef.
+         CALL Cdn10_Lupkes2015( ptsui, pslp, Cd_ice, Ch_ice )
+         Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical
+      ENDIF
+
+      !! IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice)   ! output value of pure ice-atm. transfer coef.
+      !! IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice)   ! output value of pure ice-atm. transfer coef.
 
       ! local scalars ( place there for vector optimisation purposes)
-      ! Computing density of air! Way denser that 1.2 over sea-ice !!!
-      zrhoa (:,:) =  rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1))
-
-      !!gm brutal....
-      utau_ice  (:,:) = 0._wp
-      vtau_ice  (:,:) = 0._wp
-      !!gm end
-
-      ! ------------------------------------------------------------ !
-      !    Wind stress relative to the moving ice ( U10m - U_ice )   !
-      ! ------------------------------------------------------------ !
-      ! C-grid ice dynamics :   U & V-points (same as ocean)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )            &
-               &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) )
-            vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )            &
-               &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) )
-         END DO
-      END DO
-      CALL lbc_lnk_multi( 'sbcblk', utau_ice, 'U', -1., vtau_ice, 'V', -1. )
-      !
-      !
-      IF(ln_ctl) THEN
-         CALL prt_ctl(tab2d_1=utau_ice  , clinfo1=' blk_ice: utau_ice : ', tab2d_2=vtau_ice  , clinfo2=' vtau_ice : ')
-         CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ')
-      ENDIF
-      !
-   END SUBROUTINE blk_ice_tau
-
-
-   SUBROUTINE blk_ice_flx( ptsu, phs, phi, palb )
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_ice_flx  ***
+      !IF (ln_abl) rhoa  (:,:)  = rho_air( ptair(:,:), phumi(:,:), pslp(:,:) ) !!GS: rhoa must be (re)computed here with ABL to avoid division by zero after (TBI)
+      zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:)
+
+      IF( ln_blk ) THEN
+         ! ------------------------------------------------------------ !
+         !    Wind stress relative to the moving ice ( U10m - U_ice )   !
+         ! ------------------------------------------------------------ !
+         ! C-grid ice dynamics :   U & V-points (same as ocean)
+         DO_2D_00_00
+            putaui(ji,jj) = 0.5_wp * (  rhoa(ji+1,jj) * zcd_dui(ji+1,jj)             &
+               &                      + rhoa(ji  ,jj) * zcd_dui(ji  ,jj)  )          &
+               &         * ( 0.5_wp * ( pwndi(ji+1,jj) + pwndi(ji,jj) ) - rn_vfac * puice(ji,jj) )
+            pvtaui(ji,jj) = 0.5_wp * (  rhoa(ji,jj+1) * zcd_dui(ji,jj+1)             &
+               &                      + rhoa(ji,jj  ) * zcd_dui(ji,jj  )  )          &
+               &         * ( 0.5_wp * ( pwndj(ji,jj+1) + pwndj(ji,jj) ) - rn_vfac * pvice(ji,jj) )
+         END_2D
+         CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1., pvtaui, 'V', -1. )
+         !
+         IF(sn_cfctl%l_prtctl)  CALL prt_ctl( tab2d_1=putaui  , clinfo1=' blk_ice: putaui : '   &
+            &                               , tab2d_2=pvtaui  , clinfo2='          pvtaui : ' )
+      ELSE
+         zztmp1 = 11637800.0_wp
+         zztmp2 =    -5897.8_wp
+         DO_2D_11_11
+            pcd_dui(ji,jj) = zcd_dui (ji,jj)
+            pseni  (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj)
+            pevpi  (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj)
+            zootm_su       = zztmp2 / ptsui(ji,jj)   ! ptsui is in K (it can't be zero ??)
+            pssqi  (ji,jj) = zztmp1 * EXP( zootm_su ) / rhoa(ji,jj)
+         END_2D
+      ENDIF
+      !
+      IF(sn_cfctl%l_prtctl)  CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ')
+      !
+   END SUBROUTINE blk_ice_1
+
+
+   SUBROUTINE blk_ice_2( ptsu, phs, phi, palb, ptair, phumi, pslp, pqlw, pprec, psnow  )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_2  ***
       !!
       !! ** Purpose :   provide the heat and mass fluxes at air-ice interface
@@ -784 +941 @@
       !! caution : the net upward water flux has with mm/day unit
       !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature [K]
       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness
       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness
       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb   ! ice albedo (all skies)
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   ptair
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   phumi
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pslp
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pqlw
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pprec
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   psnow
       !!
       INTEGER  ::   ji, jj, jl               ! dummy loop indices
       REAL(wp) ::   zst3                     ! local variable
       REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      -
-      REAL(wp) ::   zztmp, z1_rLsub           !   -      -
+      REAL(wp) ::   zztmp, zztmp2, z1_rLsub  !   -      -
       REAL(wp) ::   zfr1, zfr2               ! local variables
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_st         ! inverse of surface temperature
@@ -800 +963 @@
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_dqsb        ! sensible  heat sensitivity over ice
       REAL(wp), DIMENSION(jpi,jpj)     ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (SI3)
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zrhoa
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zqair         ! specific humidity of air at z=rn_zqt [kg/kg] !LB
       REAL(wp), DIMENSION(jpi,jpj)     ::   ztmp, ztmp2
       !!---------------------------------------------------------------------
       !
-      zcoef_dqlw = 4.0 * 0.95 * Stef             ! local scalars
-      zcoef_dqla = -Ls * 11637800. * (-5897.8)
-      !
-      zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) )
+      zcoef_dqlw = 4._wp * 0.95_wp * stefan             ! local scalars
+      zcoef_dqla = -rLsub * 11637800._wp * (-5897.8_wp) !LB: BAD!
+      !
+      SELECT CASE( nhumi )
+      CASE( np_humi_sph )
+         zqair(:,:) =  phumi(:,:)      ! what we read in file is already a spec. humidity!
+      CASE( np_humi_dpt )
+         zqair(:,:) = q_sat( phumi(:,:), pslp )
+      CASE( np_humi_rlh )
+         zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file
+      END SELECT
       !
       zztmp = 1. / ( 1. - albo )
-      WHERE( ptsu(:,:,:) /= 0._wp )   ;   z1_st(:,:,:) = 1._wp / ptsu(:,:,:)
-      ELSEWHERE                       ;   z1_st(:,:,:) = 0._wp
+      WHERE( ptsu(:,:,:) /= 0._wp )
+         z1_st(:,:,:) = 1._wp / ptsu(:,:,:)
+      ELSEWHERE
+         z1_st(:,:,:) = 0._wp
       END WHERE
       !                                     ! ========================== !
@@ -825 +997 @@
                qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
                ! Long  Wave (lw)
-               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
+               z_qlw(ji,jj,jl) = 0.95 * ( pqlw(ji,jj) - stefan * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
                ! lw sensitivity
                z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3
@@ -833 +1005 @@
                ! ----------------------------!
 
-               ! ... turbulent heat fluxes with Ch_atm recalculated in blk_ice_tau
+               ! ... turbulent heat fluxes with Ch_ice recalculated in blk_ice_1
                ! Sensible Heat
-               z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1))
+               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))
                ! Latent Heat
-               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls  * Ch_atm(ji,jj) * wndm_ice(ji,jj) *  &
-                  &                ( 11637800. * EXP( -5897.8 * z1_st(ji,jj,jl) ) / zrhoa(ji,jj) - sf(jp_humi)%fnow(ji,jj,1) ) )
+               zztmp2 = EXP( -5897.8 * z1_st(ji,jj,jl) )
+               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa(ji,jj) * rLsub  * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  &
+                  &                ( 11637800. * zztmp2 / rhoa(ji,jj) - zqair(ji,jj) ) )
                ! Latent heat sensitivity for ice (Dqla/Dt)
                IF( qla_ice(ji,jj,jl) > 0._wp ) THEN
-                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ch_atm(ji,jj) * wndm_ice(ji,jj) *  &
-                     &                 z1_st(ji,jj,jl)*z1_st(ji,jj,jl) * EXP(-5897.8 * z1_st(ji,jj,jl))
+                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  &
+                     &                 z1_st(ji,jj,jl) * z1_st(ji,jj,jl) * zztmp2
                ELSE
                   dqla_ice(ji,jj,jl) = 0._wp
@@ -848 +1021 @@
 
                ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice)
-               z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj)
+               z_dqsb(ji,jj,jl) = rhoa(ji,jj) * rCp_air * Ch_ice(ji,jj) * wndm_ice(ji,jj)
 
                ! ----------------------------!
@@ -863 +1036 @@
       END DO
       !
-      tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)  ! total precipitation [kg/m2/s]
-      sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)  ! solid precipitation [kg/m2/s]
-      CALL iom_put( 'snowpre', sprecip )                    ! Snow precipitation
-      CALL iom_put( 'precip' , tprecip )                    ! Total precipitation
+      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)  ! total precipitation [kg/m2/s]
+      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)  ! solid precipitation [kg/m2/s]
+      CALL iom_put( 'snowpre', sprecip )                  ! Snow precipitation
+      CALL iom_put( 'precip' , tprecip )                  ! Total precipitation
 
       ! --- evaporation --- !
@@ -883 +1056 @@
       ! --- heat flux associated with emp --- !
       qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * sst_m(:,:) * rcp                  & ! evap at sst
-         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair
+         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( ptair(:,:) - rt0 ) * rcp               & ! liquid precip at Tair
          &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow)
-         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
+         &              ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
       qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only)
-         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
+         &              ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
 
       ! --- total solar and non solar fluxes --- !
@@ -895 +1068 @@
 
       ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
-      qprec_ice(:,:) = rhos * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
+      qprec_ice(:,:) = rhos * ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
 
       ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) ---
       DO jl = 1, jpl
          qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * rcpi * tmask(:,:,1) )
-         !                         ! But we do not have Tice => consider it at 0degC => evap=0 
+         !                         ! But we do not have Tice => consider it at 0degC => evap=0
       END DO
 
@@ -907 +1080 @@
       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1
       !
-      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm  
+      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm
          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) )
       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm
          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1
       ELSEWHERE                                                         ! zero when hs>0
-         qtr_ice_top(:,:,:) = 0._wp 
+         qtr_ice_top(:,:,:) = 0._wp
       END WHERE
       !
 
       IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN
-         ztmp(:,:) = zevap(:,:) * ( 1._wp - at_i_b(:,:) ) 
-         CALL iom_put( 'evap_ao_cea'  , ztmp(:,:) * tmask(:,:,1) )   ! ice-free oce evap (cell average)
-         CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * sst_m(:,:) * rcp * tmask(:,:,1) )   ! heat flux from evap (cell average)
+         ztmp(:,:) = zevap(:,:) * ( 1._wp - at_i_b(:,:) )
+         IF( iom_use('evap_ao_cea'  ) )  CALL iom_put( 'evap_ao_cea'  , ztmp(:,:) * tmask(:,:,1) )   ! ice-free oce evap (cell average)
+         IF( iom_use('hflx_evap_cea') )  CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * sst_m(:,:) * rcp * tmask(:,:,1) )   ! heat flux from evap (cell average)
       ENDIF
       IF( iom_use('hflx_rain_cea') ) THEN
          ztmp(:,:) = rcp * ( SUM( (ptsu-rt0) * a_i_b, dim=3 ) + sst_m(:,:) * ( 1._wp - at_i_b(:,:) ) )
-         CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * ztmp(:,:) )   ! heat flux from rain (cell average)
+         IF( iom_use('hflx_rain_cea') )  CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * ztmp(:,:) )   ! heat flux from rain (cell average)
       ENDIF
       IF( iom_use('hflx_snow_cea') .OR. iom_use('hflx_snow_ao_cea') .OR. iom_use('hflx_snow_ai_cea')  )  THEN
-          WHERE( SUM( a_i_b, dim=3 ) > 1.e-10 ) ;   ztmp(:,:) = rcpi * SUM( (ptsu-rt0) * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 )
-          ELSEWHERE                             ;   ztmp(:,:) = rcp * sst_m(:,:)    
-          ENDWHERE
-          ztmp2(:,:) = sprecip(:,:) * ( ztmp(:,:) - rLfus ) 
-          CALL iom_put('hflx_snow_cea'   , ztmp2(:,:) ) ! heat flux from snow (cell average)
-          CALL iom_put('hflx_snow_ao_cea', ztmp2(:,:) * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean)
-          CALL iom_put('hflx_snow_ai_cea', ztmp2(:,:) *           zsnw(:,:)   ) ! heat flux from snow (over ice)
-      ENDIF
-      !
-      IF(ln_ctl) THEN
+         WHERE( SUM( a_i_b, dim=3 ) > 1.e-10 )
+            ztmp(:,:) = rcpi * SUM( (ptsu-rt0) * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 )
+         ELSEWHERE
+            ztmp(:,:) = rcp * sst_m(:,:)
+         ENDWHERE
+         ztmp2(:,:) = sprecip(:,:) * ( ztmp(:,:) - rLfus )
+         IF( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , ztmp2(:,:) ) ! heat flux from snow (cell average)
+         IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', ztmp2(:,:) * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean)
+         IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', ztmp2(:,:) *           zsnw(:,:)   ) ! heat flux from snow (over ice)
+      ENDIF
+      !
+      IF(sn_cfctl%l_prtctl) THEN
          CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice: qla_ice  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb    : ', kdim=jpl)
          CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice: z_qlw    : ', tab3d_2=dqla_ice, clinfo2=' dqla_ice : ', kdim=jpl)
@@ -944 +1119 @@
       ENDIF
       !
-   END SUBROUTINE blk_ice_flx
-   
+   END SUBROUTINE blk_ice_2
+
 
    SUBROUTINE blk_ice_qcn( ld_virtual_itd, ptsu, ptb, phs, phi )
@@ -954 +1129 @@
       !!                to force sea ice / snow thermodynamics
       !!                in the case conduction flux is emulated
-      !!                
+      !!
       !! ** Method  :   compute surface energy balance assuming neglecting heat storage
       !!                following the 0-layer Semtner (1976) approach
@@ -979 +1154 @@
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zgfac   ! enhanced conduction factor
       !!---------------------------------------------------------------------
-      
+
       ! -------------------------------------!
       !      I   Enhanced conduction factor  !
@@ -987 +1162 @@
       !
       zgfac(:,:,:) = 1._wp
-      
+
       IF( ld_virtual_itd ) THEN
          !
@@ -993 +1168 @@
          zfac2 = EXP(1._wp) * 0.5_wp * zepsilon
          zfac3 = 2._wp / zepsilon
-         !   
-         DO jl = 1, jpl                
-            DO jj = 1 , jpj
-               DO ji = 1, jpi
-                  zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac                            ! Effective thickness
-                  IF( zhe >=  zfac2 )   zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor
-               END DO
-            END DO
+         !
+         DO jl = 1, jpl
+            DO_2D_11_11
+               zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac                            ! Effective thickness
+               IF( zhe >=  zfac2 )   zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor
+            END_2D
          END DO
-         !      
-      ENDIF
-      
+         !
+      ENDIF
+
       ! -------------------------------------------------------------!
       !      II   Surface temperature and conduction flux            !
@@ -1012 +1185 @@
       !
       DO jl = 1, jpl
-         DO jj = 1 , jpj
-            DO ji = 1, jpi
-               !                    
-               zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness
-                  &      ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) )
-               ztsu    = ptsu(ji,jj,jl)                                                ! Store current iteration temperature
-               ztsu0   = ptsu(ji,jj,jl)                                                ! Store initial surface temperature
-               zqa0    = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux
-               !
-               DO iter = 1, nit     ! --- Iterative loop
-                  zqc   = zkeff_h * ( ztsu - ptb(ji,jj) )                              ! Conduction heat flux through snow-ice system (>0 downwards)
-                  zqnet = zqa0 + dqns_ice(ji,jj,jl) * ( ztsu - ptsu(ji,jj,jl) ) - zqc  ! Surface energy budget
-                  ztsu  = ztsu - zqnet / ( dqns_ice(ji,jj,jl) - zkeff_h )              ! Temperature update
-               END DO
-               !
-               ptsu   (ji,jj,jl) = MIN( rt0, ztsu )
-               qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) )
-               qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 )
-               qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )  &
-                             &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) )
-
-               ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- !
-               hfx_err_dif(ji,jj) = hfx_err_dif(ji,jj) - ( dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) ) * a_i_b(ji,jj,jl) 
-
+         DO_2D_11_11
+            !
+            zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness
+               &      ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) )
+            ztsu    = ptsu(ji,jj,jl)                                                ! Store current iteration temperature
+            ztsu0   = ptsu(ji,jj,jl)                                                ! Store initial surface temperature
+            zqa0    = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux
+            !
+            DO iter = 1, nit     ! --- Iterative loop
+               zqc   = zkeff_h * ( ztsu - ptb(ji,jj) )                              ! Conduction heat flux through snow-ice system (>0 downwards)
+               zqnet = zqa0 + dqns_ice(ji,jj,jl) * ( ztsu - ptsu(ji,jj,jl) ) - zqc  ! Surface energy budget
+               ztsu  = ztsu - zqnet / ( dqns_ice(ji,jj,jl) - zkeff_h )              ! Temperature update
             END DO
-         END DO
+            !
+            ptsu   (ji,jj,jl) = MIN( rt0, ztsu )
+            qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) )
+            qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 )
+            qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )  &
+               &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) )
+
+            ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- !
+            hfx_err_dif(ji,jj) = hfx_err_dif(ji,jj) - ( dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) ) * a_i_b(ji,jj,jl)
+
+         END_2D
          !
-      END DO 
-      !      
+      END DO
+      !
    END SUBROUTINE blk_ice_qcn
-   
-
-   SUBROUTINE Cdn10_Lupkes2012( Cd )
+
+
+   SUBROUTINE Cdn10_Lupkes2012( pcd )
       !!----------------------------------------------------------------------
       !!                      ***  ROUTINE  Cdn10_Lupkes2012  ***
       !!
-      !! ** Purpose :    Recompute the neutral air-ice drag referenced at 10m 
+      !! ** Purpose :    Recompute the neutral air-ice drag referenced at 10m
       !!                 to make it dependent on edges at leads, melt ponds and flows.
       !!                 After some approximations, this can be resumed to a dependency
       !!                 on ice concentration.
-      !!                
+      !!
       !! ** Method :     The parameterization is taken from Lupkes et al. (2012) eq.(50)
       !!                 with the highest level of approximation: level4, eq.(59)
@@ -1064 +1235 @@
       !!
       !!                 This new drag has a parabolic shape (as a function of A) starting at
-      !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5 
+      !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5
       !!                 and going down to Cdi(say 1.4e-3) for A=1
       !!
@@ -1074 +1245 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd
       REAL(wp), PARAMETER ::   zCe   = 2.23e-03_wp
       REAL(wp), PARAMETER ::   znu   = 1._wp
@@ -1089 +1260 @@
 
       ! ice-atm drag
-      Cd(:,:) = Cd_ice +  &                                                         ! pure ice drag
-         &      zCe    * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology
-      
+      pcd(:,:) = rCd_ice +  &                                                         ! pure ice drag
+         &      zCe     * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology
+
    END SUBROUTINE Cdn10_Lupkes2012
 
 
-   SUBROUTINE Cdn10_Lupkes2015( Cd, Ch )
+   SUBROUTINE Cdn10_Lupkes2015( ptm_su, pslp, pcd, pch )
       !!----------------------------------------------------------------------
       !!                      ***  ROUTINE  Cdn10_Lupkes2015  ***
       !!
       !! ** pUrpose :    Alternative turbulent transfert coefficients formulation
-      !!                 between sea-ice and atmosphere with distinct momentum 
-      !!                 and heat coefficients depending on sea-ice concentration 
+      !!                 between sea-ice and atmosphere with distinct momentum
+      !!                 and heat coefficients depending on sea-ice concentration
       !!                 and atmospheric stability (no meltponds effect for now).
-      !!                
+      !!
       !! ** Method :     The parameterization is adapted from Lupkes et al. (2015)
       !!                 and ECHAM6 atmospheric model. Compared to Lupkes2012 scheme,
       !!                 it considers specific skin and form drags (Andreas et al. 2010)
-      !!                 to compute neutral transfert coefficients for both heat and 
+      !!                 to compute neutral transfert coefficients for both heat and
       !!                 momemtum fluxes. Atmospheric stability effect on transfert
       !!                 coefficient is also taken into account following Louis (1979).
@@ -1116 +1287 @@
       !!----------------------------------------------------------------------
       !
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Ch
-      REAL(wp), DIMENSION(jpi,jpj)            ::   ztm_su, zst, zqo_sat, zqi_sat
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   ptm_su ! sea-ice surface temperature [K]
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pslp   ! sea-level pressure [Pa]
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd    ! momentum transfert coefficient
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pch    ! heat transfert coefficient
+      REAL(wp), DIMENSION(jpi,jpj)            ::   zst, zqo_sat, zqi_sat
       !
       ! ECHAM6 constants
@@ -1146 +1319 @@
       !!----------------------------------------------------------------------
 
-      ! mean temperature
-      WHERE( at_i_b(:,:) > 1.e-20 )   ;   ztm_su(:,:) = SUM( t_su(:,:,:) * a_i_b(:,:,:) , dim=3 ) / at_i_b(:,:)
-      ELSEWHERE                       ;   ztm_su(:,:) = rt0
-      ENDWHERE
-      
       ! Momentum Neutral Transfert Coefficients (should be a constant)
       zCdn_form_tmp = zce10 * ( LOG( 10._wp / z0_form_ice + 1._wp ) / LOG( rn_zu / z0_form_ice + 1._wp ) )**2   ! Eq. 40
       zCdn_skin_ice = ( vkarmn                                      / LOG( rn_zu / z0_skin_ice + 1._wp ) )**2   ! Eq. 7
-      zCdn_ice      = zCdn_skin_ice   ! Eq. 7 (cf Lupkes email for details)
+      zCdn_ice      = zCdn_skin_ice   ! Eq. 7
       !zCdn_ice     = 1.89e-3         ! old ECHAM5 value (cf Eq. 32)
 
       ! Heat Neutral Transfert Coefficients
-      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 (cf Lupkes email for details)
-     
+      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
+
       ! Atmospheric and Surface Variables
       zst(:,:)     = sst_m(:,:) + rt0                                        ! convert SST from Celcius to Kelvin
-      zqo_sat(:,:) = 0.98_wp * q_sat( zst(:,:)   , sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ocean [kg/kg]
-      zqi_sat(:,:) = 0.98_wp * q_sat( ztm_su(:,:), sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ice   [kg/kg]
-      !
-      DO jj = 2, jpjm1           ! reduced loop is necessary for reproducibility
-         DO ji = fs_2, fs_jpim1
-            ! Virtual potential temperature [K]
-            zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean
-            zthetav_is = ztm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice
-            zthetav_zu = t_zu (ji,jj)  * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu
-            
-            ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead)
-            zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean
-            zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice
-            
-            ! Momentum and Heat Neutral Transfert Coefficients
-            zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40
-            zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53 
-                       
-            ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead)
-            z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water
-            z0i = z0_skin_ice                                             ! over ice (cf Lupkes email for details)
-            IF( zrib_o <= 0._wp ) THEN
-               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
-               zfhw = ( 1._wp + ( zbetah * ( zthetav_os - zthetav_zu )**r1_3 / ( Chn_oce(ji,jj) * MAX(0.01, wndm(ji,jj)) )   &     ! Eq. 26
-                  &             )**zgamma )**z1_gamma
-            ELSE
-               zfmw = 1._wp / ( 1._wp + zam * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 12
-               zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28
-            ENDIF
-            
-            IF( zrib_i <= 0._wp ) THEN
-               zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9
-               zfhi = 1._wp - zah * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq. 25
-            ELSE
-               zfmi = 1._wp / ( 1._wp + zam * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 11
-               zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27
-            ENDIF
-            
-            ! Momentum Transfert Coefficients (Eq. 38)
-            Cd(ji,jj) = zCdn_skin_ice *   zfmi +  &
-               &        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) )
-            
-            ! Heat Transfert Coefficients (Eq. 49)
-            Ch(ji,jj) = zChn_skin_ice *   zfhi +  &
-               &        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) )
-            !
-         END DO
-      END DO
-      CALL lbc_lnk_multi( 'sbcblk', Cd, 'T',  1., Ch, 'T', 1. )
+      zqo_sat(:,:) = rdct_qsat_salt * q_sat( zst(:,:)   , pslp(:,:) )   ! saturation humidity over ocean [kg/kg]
+      zqi_sat(:,:) =                  q_sat( ptm_su(:,:), pslp(:,:) )   ! saturation humidity over ice   [kg/kg]
+      !
+      DO_2D_00_00
+         ! Virtual potential temperature [K]
+         zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean
+         zthetav_is = ptm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice
+         zthetav_zu = t_zu (ji,jj)  * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu
+
+         ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead)
+         zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean
+         zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice
+
+         ! Momentum and Heat Neutral Transfert Coefficients
+         zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40
+         zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53
+
+         ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead ?)
+         z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water
+         z0i = z0_skin_ice                                             ! over ice
+         IF( zrib_o <= 0._wp ) THEN
+            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
+            zfhw = ( 1._wp + ( zbetah * ( zthetav_os - zthetav_zu )**r1_3 / ( Chn_oce(ji,jj) * MAX(0.01, wndm(ji,jj)) )   &     ! Eq. 26
+               &             )**zgamma )**z1_gamma
+         ELSE
+            zfmw = 1._wp / ( 1._wp + zam * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 12
+            zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28
+         ENDIF
+
+         IF( zrib_i <= 0._wp ) THEN
+            zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9
+            zfhi = 1._wp - zah * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq. 25
+         ELSE
+            zfmi = 1._wp / ( 1._wp + zam * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 11
+            zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27
+         ENDIF
+
+         ! Momentum Transfert Coefficients (Eq. 38)
+         pcd(ji,jj) = zCdn_skin_ice *   zfmi +  &
+            &        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) )
+
+         ! Heat Transfert Coefficients (Eq. 49)
+         pch(ji,jj) = zChn_skin_ice *   zfhi +  &
+            &        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) )
+         !
+      END_2D
+      CALL lbc_lnk_multi( 'sbcblk', pcd, 'T',  1., pch, 'T', 1. )
       !
    END SUBROUTINE Cdn10_Lupkes2015

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

@@ -1 +1 @@
 MODULE sbcblk_algo_ecmwf
    !!======================================================================
-   !!                       ***  MODULE  sbcblk_algo_ecmwf  ***
-   !! Computes turbulent components of surface fluxes
-   !!         according to the method in IFS of the ECMWF model
-   !!
+   !!                   ***  MODULE  sbcblk_algo_ecmwf  ***
+   !! Computes:
    !!   * bulk transfer coefficients C_D, C_E and C_H
    !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed
@@ -10 +8 @@
    !!   => all these are used in bulk formulas in sbcblk.F90
    !!
-   !!    Using the bulk formulation/param. of IFS of ECMWF (cycle 31r2)
+   !!    Using the bulk formulation/param. of IFS of ECMWF (cycle 40r1)
    !!         based on IFS doc (avaible online on the ECMWF's website)
    !!
+   !!       Routine turb_ecmwf maintained and developed in AeroBulk
+   !!                     (https://github.com/brodeau/aerobulk)
    !!
-   !!       Routine turb_ecmwf maintained and developed in AeroBulk
-   !!                     (http://aerobulk.sourceforge.net/)
-   !!
-   !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+   !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk)
    !!----------------------------------------------------------------------
    !! History :  4.0  !  2016-02  (L.Brodeau)   Original code
@@ -41 +38 @@
 
    USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB
+   USE sbcblk_skin_ecmwf ! cool-skin/warm layer scheme !LB
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC ::   TURB_ECMWF   ! called by sbcblk.F90
-
-   !                   !! ECMWF own values for given constants, taken form IFS documentation...
+   PUBLIC :: SBCBLK_ALGO_ECMWF_INIT, TURB_ECMWF
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
+   !! ECMWF own values for given constants, taken form IFS documentation...
    REAL(wp), PARAMETER ::   charn0 = 0.018    ! Charnock constant (pretty high value here !!!
    !                                          !    =>  Usually 0.011 for moderate winds)
    REAL(wp), PARAMETER ::   zi0     = 1000.   ! scale height of the atmospheric boundary layer...1
    REAL(wp), PARAMETER ::   Beta0    = 1.     ! gustiness parameter ( = 1.25 in COAREv3)
-   REAL(wp), PARAMETER ::   rctv0    = 0.608  ! constant to obtain virtual temperature...
-   REAL(wp), PARAMETER ::   Cp_dry = 1005.0   ! Specic heat of dry air, constant pressure      [J/K/kg]
-   REAL(wp), PARAMETER ::   Cp_vap = 1860.0   ! Specic heat of water vapor, constant pressure  [J/K/kg]
    REAL(wp), PARAMETER ::   alpha_M = 0.11    ! For roughness length (smooth surface term)
    REAL(wp), PARAMETER ::   alpha_H = 0.40    ! (Chapter 3, p.34, IFS doc Cy31r1)
    REAL(wp), PARAMETER ::   alpha_Q = 0.62    !
+
+   INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations
+
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE TURB_ECMWF( zt, zu, sst, t_zt, ssq , q_zt , U_zu,   &
-      &                   Cd, Ch, Ce , t_zu, q_zu, U_blk,         &
-      &                   Cdn, Chn, Cen                           )
-      !!----------------------------------------------------------------------------------
-      !!                      ***  ROUTINE  turb_ecmwf  ***
-      !!
-      !!            2015: L. Brodeau (brodeau@gmail.com)
-      !!
-      !! ** Purpose :   Computes turbulent transfert coefficients of surface
-      !!                fluxes according to IFS doc. (cycle 31)
-      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
-      !!
-      !! ** Method : Monin Obukhov Similarity Theory
+
+   SUBROUTINE sbcblk_algo_ecmwf_init(l_use_cs, l_use_wl)
+      !!---------------------------------------------------------------------
+      !!                  ***  FUNCTION sbcblk_algo_ecmwf_init  ***
       !!
       !! INPUT :
       !! -------
+      !!    * l_use_cs : use the cool-skin parameterization
+      !!    * l_use_wl : use the warm-layer parameterization
+      !!---------------------------------------------------------------------
+      LOGICAL , INTENT(in) ::   l_use_cs ! use the cool-skin parameterization
+      LOGICAL , INTENT(in) ::   l_use_wl ! use the warm-layer parameterization
+      INTEGER :: ierr
+      !!---------------------------------------------------------------------
+      IF( l_use_wl ) THEN
+         ierr = 0
+         ALLOCATE ( dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr )
+         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_wl & Hz_wl failed!' )
+         dT_wl(:,:)  = 0._wp
+         Hz_wl(:,:)  = rd0 ! (rd0, constant, = 3m is default for Zeng & Beljaars)
+      ENDIF
+      IF( l_use_cs ) THEN
+         ierr = 0
+         ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr )
+         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_cs failed!' )
+         dT_cs(:,:) = -0.25_wp  ! First guess of skin correction
+      ENDIF
+   END SUBROUTINE sbcblk_algo_ecmwf_init
+
+
+
+   SUBROUTINE turb_ecmwf( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, &
+      &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                           &
+      &                      Cdn, Chn, Cen,                                           &
+      &                      Qsw, rad_lw, slp, pdT_cs,                                & ! optionals for cool-skin (and warm-layer)
+      &                      pdT_wl, pHz_wl )                                           ! optionals for warm-layer only
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE  turb_ecmwf  ***
+      !!
+      !! ** Purpose :   Computes turbulent transfert coefficients of surface
+      !!                fluxes according to IFS doc. (cycle 45r1)
+      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
+      !!                Returns the effective bulk wind speed at zu to be used in the bulk formulas
+      !!
+      !!                Applies the cool-skin warm-layer correction of the SST to T_s
+      !!                if the net shortwave flux at the surface (Qsw), the downwelling longwave
+      !!                radiative fluxes at the surface (rad_lw), and the sea-leve pressure (slp)
+      !!                are provided as (optional) arguments!
+      !!
+      !! INPUT :
+      !! -------
+      !!    *  kt   : current time step (starts at 1)
       !!    *  zt   : height for temperature and spec. hum. of air            [m]
-      !!    *  zu   : height for wind speed (generally 10m)                   [m]
-      !!    *  U_zu : scalar wind speed at 10m                                [m/s]
-      !!    *  sst  : SST                                                     [K]
+      !!    *  zu   : height for wind speed (usually 10m)                     [m]
       !!    *  t_zt : potential air temperature at zt                         [K]
-      !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg]
       !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
-      !!
+      !!    *  U_zu : scalar wind speed at zu                                 [m/s]
+      !!    * l_use_cs : use the cool-skin parameterization
+      !!    * l_use_wl : use the warm-layer parameterization
+      !!
+      !! INPUT/OUTPUT:
+      !! -------------
+      !!    *  T_s  : always "bulk SST" as input                              [K]
+      !!              -> unchanged "bulk SST" as output if CSWL not used      [K]
+      !!              -> skin temperature as output if CSWL used              [K]
+      !!
+      !!    *  q_s  : SSQ aka saturation specific humidity at temp. T_s       [kg/kg]
+      !!              -> doesn't need to be given a value if skin temp computed (in case l_use_cs=True or l_use_wl=True)
+      !!              -> MUST be given the correct value if not computing skint temp. (in case l_use_cs=False or l_use_wl=False)
+      !!
+      !! OPTIONAL INPUT:
+      !! ---------------
+      !!    *  Qsw    : net solar flux (after albedo) at the surface (>0)     [W/m^2]
+      !!    *  rad_lw : downwelling longwave radiation at the surface  (>0)   [W/m^2]
+      !!    *  slp    : sea-level pressure                                    [Pa]
+      !!
+      !! OPTIONAL OUTPUT:
+      !! ----------------
+      !!    * pdT_cs  : SST increment "dT" for cool-skin correction           [K]
+      !!    * pdT_wl  : SST increment "dT" for warm-layer correction          [K]
+      !!    * pHz_wl  : thickness of warm-layer                               [m]
       !!
       !! OUTPUT :
@@ -93 +151 @@
       !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
       !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
-      !!    *  U_blk  : bulk wind at 10m                                      [m/s]
-      !!
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
+      !!    *  U_blk  : bulk wind speed at zu                                 [m/s]
+      !!
+      !!
+      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      INTEGER,  INTENT(in   )                     ::   kt       ! current time step
       REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m]
       REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                             [m]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature                [Kelvin]
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   T_s      ! sea surface temperature                [Kelvin]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg]
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   q_s      ! sea surface specific humidity           [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s]
+      LOGICAL , INTENT(in   )                     ::   l_use_cs ! use the cool-skin parameterization
+      LOGICAL , INTENT(in   )                     ::   l_use_wl ! use the warm-layer parameterization
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens)
@@ -110 +171 @@
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
       !
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2]
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2]
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   slp      !             [Pa]
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_cs
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_wl   !             [K]
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m]
+      !
       INTEGER :: j_itt
-      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
-      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations
-      !
-      REAL(wp), DIMENSION(jpi,jpj) ::   u_star, t_star, q_star,   &
-         &  dt_zu, dq_zu,    &
-         &  znu_a,           & !: Nu_air, Viscosity of air
-         &  Linv,            & !: 1/L (inverse of Monin Obukhov length...
-         &  z0, z0t, z0q
-      REAL(wp), DIMENSION(jpi,jpj) ::   func_m, func_h
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp0, ztmp1, ztmp2
-      !!----------------------------------------------------------------------------------
-      !
-      ! Identical first gess as in COARE, with IFS parameter values though
-      !
+      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
+      !
+      REAL(wp), DIMENSION(jpi,jpj) ::  u_star, t_star, q_star
+      REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu     
+      REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air
+      REAL(wp), DIMENSION(jpi,jpj) :: Linv  !: 1/L (inverse of Monin Obukhov length...
+      REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q
+      !
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst  ! to back up the initial bulk SST
+      !
+      REAL(wp), DIMENSION(jpi,jpj) :: func_m, func_h
+      REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2
+      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90'
+      !!----------------------------------------------------------------------------------
+
+      IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl)
+
       l_zt_equal_zu = .FALSE.
-      IF( ABS(zu - zt) < 0.01 )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
-
-
+      IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
+
+      !! Initializations for cool skin and warm layer:
+      IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
+         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use cool-skin param!' )
+
+      IF( l_use_wl .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
+         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' )
+
+      IF( l_use_cs .OR. l_use_wl ) THEN
+         ALLOCATE ( zsst(jpi,jpj) )
+         zsst = T_s ! backing up the bulk SST
+         IF( l_use_cs ) T_s = T_s - 0.25_wp   ! First guess of correction
+         q_s    = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s
+      ENDIF
+
+
+      ! Identical first gess as in COARE, with IFS parameter values though...
+      !
       !! First guess of temperature and humidity at height zu:
-      t_zu = MAX( t_zt , 0.0  )   ! who knows what's given on masked-continental regions...
-      q_zu = MAX( q_zt , 1.e-6)   !               "
+      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions...
+      q_zu = MAX( q_zt , 1.e-6_wp )   !               "
 
       !! Pot. temp. difference (and we don't want it to be 0!)
-      dt_zu = t_zu - sst   ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.e-6), dt_zu )
-      dq_zu = q_zu - ssq   ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.e-9), dq_zu )
-
-      znu_a = visc_air(t_zt) ! Air viscosity (m^2/s) at zt given from temperature in (K)
-
-      ztmp2 = 0.5 * 0.5  ! initial guess for wind gustiness contribution
-      U_blk = SQRT(U_zu*U_zu + ztmp2)
-
-      ! z0     = 0.0001
-      ztmp2   = 10000.     ! optimization: ztmp2 == 1/z0
-      ztmp0   = LOG(zu*ztmp2)
-      ztmp1   = LOG(10.*ztmp2)
-      u_star = 0.035*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
-
-      z0     = charn0*u_star*u_star/grav + 0.11*znu_a/u_star
-      z0t    = 0.1*EXP(vkarmn/(0.00115/(vkarmn/ztmp1)))   !  WARNING: 1/z0t !
+      dt_zu = t_zu - T_s ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+      dq_zu = q_zu - q_s ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
+
+      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K)
+
+      U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution
+
+      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001)
+      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               "
+      u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
+
+      z0     = charn0*u_star*u_star/grav + 0.11_wp*znu_a/u_star
+      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
+
+      z0t    = 1._wp / ( 0.1_wp*EXP(vkarmn/(0.00115/(vkarmn/ztmp1))) )
+      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
 
       Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd
 
-      ztmp0 = vkarmn*vkarmn/LOG(zt*z0t)/Cd
-
-      ztmp2 = Ri_bulk( zu, t_zu, dt_zu, q_zu, dq_zu, U_blk )   ! Ribu = Bulk Richardson number
-
-      !! First estimate of zeta_u, depending on the stability, ie sign of Ribu (ztmp2):
-      ztmp1 = 0.5 + SIGN( 0.5 , ztmp2 )
+      ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd
+
+      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN)
+
+      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2):
+      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 )
       func_m = ztmp0*ztmp2 ! temporary array !!
-      !!             Ribu < 0                                 Ribu > 0   Beta = 1.25
-      func_h = (1.-ztmp1)*(func_m/(1.+ztmp2/(-zu/(zi0*0.004*Beta0**3)))) &  ! temporary array !!! func_h == zeta_u
-         &  +     ztmp1*(func_m*(1. + 27./9.*ztmp2/ztmp0))
+      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
+         &  +     ztmp1   * (func_m*(1._wp + 27._wp/9._wp*ztmp2/func_m))              !  BRN > 0
+      !#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" !
 
       !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L
-      ztmp0   =        vkarmn/(LOG(zu*z0t) - psi_h_ecmwf(func_h))
-
-      u_star = U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h))
+      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_ecmwf(func_h))
+
+      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)
       t_star = dt_zu*ztmp0
       q_star = dq_zu*ztmp0
 
-      ! What's need to be done if zt /= zu:
+      ! What needs to be done if zt /= zu:
       IF( .NOT. l_zt_equal_zu ) THEN
-         !
          !! First update of values at zu (or zt for wind)
          ztmp0 = psi_h_ecmwf(func_h) - psi_h_ecmwf(zt*func_h/zu)    ! zt*func_h/zu == zeta_t
-         ztmp1 = log(zt/zu) + ztmp0
+         ztmp1 = LOG(zt/zu) + ztmp0
          t_zu = t_zt - t_star/vkarmn*ztmp1
          q_zu = q_zt - q_star/vkarmn*ztmp1
-         q_zu = (0.5 + sign(0.5,q_zu))*q_zu !Makes it impossible to have negative humidity :
-
-         dt_zu = t_zu - sst  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
-         dq_zu = q_zu - ssq  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
-         !
+         q_zu = (0.5_wp + SIGN(0.5_wp,q_zu))*q_zu !Makes it impossible to have negative humidity :
+         !
+         dt_zu = t_zu - T_s  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+         dq_zu = q_zu - q_s  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
       ENDIF
 
@@ -194 +279 @@
 
       !! First guess of inverse of Monin-Obukov length (1/L) :
-      ztmp0 = (1. + rctv0*q_zu)  ! the factor to apply to temp. to get virt. temp...
-      Linv  =  grav*vkarmn*(t_star*ztmp0 + rctv0*t_zu*q_star) / ( u_star*u_star * t_zu*ztmp0 )
+      Linv = One_on_L( t_zu, q_zu, u_star, t_star, q_star )
 
       !! Functions such as  u* = U_blk*vkarmn/func_m
-      ztmp1 = zu + z0
-      ztmp0 = ztmp1*Linv
-      func_m = LOG(ztmp1) -LOG(z0) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0*Linv)
-      func_h = LOG(ztmp1*z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(1./z0t*Linv)
-
+      ztmp0 = zu*Linv
+      func_m = LOG(zu) - LOG(z0)  - psi_m_ecmwf(ztmp0) + psi_m_ecmwf( z0*Linv)
+      func_h = LOG(zu) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv)
 
       !! ITERATION BLOCK
-      !! ***************
-
       DO j_itt = 1, nb_itt
 
          !! Bulk Richardson Number at z=zu (Eq. 3.25)
-         ztmp0 = Ri_bulk(zu, t_zu, dt_zu, q_zu, dq_zu, U_blk)
+         ztmp0 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN)
 
          !! New estimate of the inverse of the Monin-Obukhon length (Linv == zeta/zu) :
-         Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3, p.33, IFS doc - Cy31r1
+         Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3.2.3, IFS doc - Cy40r1
+         !! Note: it is slightly different that the L we would get with the usual
+         Linv = SIGN( MIN(ABS(Linv),200._wp), Linv ) ! (prevent FPE from stupid values from masked region later on...)
 
          !! Update func_m with new Linv:
-         ztmp1 = zu + z0
-         func_m = LOG(ztmp1) -LOG(z0) - psi_m_ecmwf(ztmp1*Linv) + psi_m_ecmwf(z0*Linv)
+         func_m = LOG(zu) -LOG(z0) - psi_m_ecmwf(zu*Linv) + psi_m_ecmwf(z0*Linv) ! LB: should be "zu+z0" rather than "zu" alone, but z0 is tiny wrt zu!
 
          !! Need to update roughness lengthes:
@@ -223 +304 @@
          ztmp2  = u_star*u_star
          ztmp1  = znu_a/u_star
-         z0    = alpha_M*ztmp1 + charn0*ztmp2/grav
-         z0t    = alpha_H*ztmp1                              ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1
-         z0q    = alpha_Q*ztmp1
-
-         !! Update wind at 10m taking into acount convection-related wind gustiness:
-         ! Only true when unstable (L<0) => when ztmp0 < 0 => - !!!
-         ztmp2 = ztmp2 * (MAX(-zi0*Linv/vkarmn,0.))**(2./3.) ! => w*^2  (combining Eq. 3.8 and 3.18, hap.3, IFS doc - Cy31r1)
-         !! => equivalent using Beta=1 (gustiness parameter, 1.25 for COARE, also zi0=600 in COARE..)
-         U_blk = MAX(sqrt(U_zu*U_zu + ztmp2), 0.2)              ! eq.3.17, Chap.3, p.32, IFS doc - Cy31r1
+         z0     = MIN( ABS( alpha_M*ztmp1 + charn0*ztmp2/grav ) , 0.001_wp)
+         z0t    = MIN( ABS( alpha_H*ztmp1                     ) , 0.001_wp)   ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1
+         z0q    = MIN( ABS( alpha_Q*ztmp1                     ) , 0.001_wp)
+
+         !! 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)
+         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)
+         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0
+         U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed
          ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0.
 
@@ -238 +318 @@
          !! as well the air-sea differences:
          IF( .NOT. l_zt_equal_zu ) THEN
-
             !! Arrays func_m and func_h are free for a while so using them as temporary arrays...
-            func_h = psi_h_ecmwf((zu+z0)*Linv) ! temporary array !!!
-            func_m = psi_h_ecmwf((zt+z0)*Linv) ! temporary array !!!
+            func_h = psi_h_ecmwf(zu*Linv) ! temporary array !!!
+            func_m = psi_h_ecmwf(zt*Linv) ! temporary array !!!
 
             ztmp2  = psi_h_ecmwf(z0t*Linv)
             ztmp0  = func_h - ztmp2
-            ztmp1  = vkarmn/(LOG(zu+z0) - LOG(z0t) - ztmp0)
+            ztmp1  = vkarmn/(LOG(zu) - LOG(z0t) - ztmp0)
             t_star = dt_zu*ztmp1
             ztmp2  = ztmp0 - func_m + ztmp2
@@ -253 +332 @@
             ztmp2  = psi_h_ecmwf(z0q*Linv)
             ztmp0  = func_h - ztmp2
-            ztmp1  = vkarmn/(LOG(zu+z0) - LOG(z0q) - ztmp0)
+            ztmp1  = vkarmn/(LOG(zu) - LOG(z0q) - ztmp0)
             q_star = dq_zu*ztmp1
             ztmp2  = ztmp0 - func_m + ztmp2
-            ztmp1  = log(zt/zu) + ztmp2
+            ztmp1  = LOG(zt/zu) + ztmp2
             q_zu   = q_zt - q_star/vkarmn*ztmp1
-
-            dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
-            dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
-
-         END IF
+         ENDIF
 
          !! Updating because of updated z0 and z0t and new Linv...
-         ztmp1 = zu + z0
-         ztmp0 = ztmp1*Linv
-         func_m = log(ztmp1) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv)
-         func_h = log(ztmp1) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv)
-
-      END DO
+         ztmp0 = zu*Linv
+         func_m = log(zu) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv)
+         func_h = log(zu) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv)
+
+
+         IF( l_use_cs ) THEN
+            !! Cool-skin contribution
+
+            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, &
+               &                   ztmp1, ztmp0,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp0
+
+            CALL CS_ECMWF( Qsw, ztmp1, u_star, zsst )  ! Qnsol -> ztmp1
+
+            T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1)
+            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1)
+            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
+
+         ENDIF
+
+         IF( l_use_wl ) THEN
+            !! Warm-layer contribution
+            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, &
+               &                   ztmp1, ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp2
+            CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst )
+            !! Updating T_s and q_s !!!
+            T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1) !
+            IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1)
+            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
+         ENDIF
+
+         IF( l_use_cs .OR. l_use_wl .OR. (.NOT. l_zt_equal_zu) ) THEN
+            dt_zu = t_zu - T_s ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+            dq_zu = q_zu - q_s ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
+         ENDIF
+
+      END DO !DO j_itt = 1, nb_itt
 
       Cd = vkarmn*vkarmn/(func_m*func_m)
       Ch = vkarmn*vkarmn/(func_m*func_h)
-      ztmp1 = log((zu + z0)/z0q) - psi_h_ecmwf((zu + z0)*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q
-      Ce = vkarmn*vkarmn/(func_m*ztmp1)
-
-      ztmp1 = zu + z0
-      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 ))
-      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t))
-      Cen = vkarmn*vkarmn / (log(ztmp1/z0q)*log(ztmp1/z0q))
-
-   END SUBROUTINE TURB_ECMWF
+      ztmp2 = log(zu/z0q) - psi_h_ecmwf(zu*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q
+      Ce = vkarmn*vkarmn/(func_m*ztmp2)
+
+      Cdn = vkarmn*vkarmn / (log(zu/z0 )*log(zu/z0 ))
+      Chn = vkarmn*vkarmn / (log(zu/z0t)*log(zu/z0t))
+      Cen = vkarmn*vkarmn / (log(zu/z0q)*log(zu/z0q))
+
+      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs
+      IF( l_use_wl .AND. PRESENT(pdT_wl) ) pdT_wl = dT_wl
+      IF( l_use_wl .AND. PRESENT(pHz_wl) ) pHz_wl = Hz_wl
+
+      IF( l_use_cs .OR. l_use_wl ) DEALLOCATE ( zsst )
+
+   END SUBROUTINE turb_ecmwf
 
 
@@ -294 +404 @@
       !!         and L is M-O length
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
       !!----------------------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ecmwf
@@ -302 +412 @@
       REAL(wp) :: zzeta, zx, ztmp, psi_unst, psi_stab, stab
       !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zzeta = MIN( pzeta(ji,jj) , 5. ) !! Very stable conditions (L positif and big!):
-            !
-            ! Unstable (Paulson 1970):
-            !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
-            zx = SQRT(ABS(1. - 16.*zzeta))
-            ztmp = 1. + SQRT(zx)
-            ztmp = ztmp*ztmp
-            psi_unst = LOG( 0.125*ztmp*(1. + zx) )   &
-               &       -2.*ATAN( SQRT(zx) ) + 0.5*rpi
-            !
-            ! Unstable:
-            ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1
-            psi_stab = -2./3.*(zzeta - 5./0.35)*EXP(-0.35*zzeta) &
-               &       - zzeta - 2./3.*5./0.35
-            !
-            ! Combining:
-            stab = 0.5 + SIGN(0.5, zzeta) ! zzeta > 0 => stab = 1
-            !
-            psi_m_ecmwf(ji,jj) = (1. - stab) * psi_unst & ! (zzeta < 0) Unstable
-               &                +      stab  * psi_stab   ! (zzeta > 0) Stable
-            !
-         END DO
-      END DO
-      !
+      DO_2D_11_11
+         !
+         zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!):
+         !
+         ! Unstable (Paulson 1970):
+         !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
+         zx = SQRT(ABS(1._wp - 16._wp*zzeta))
+         ztmp = 1._wp + SQRT(zx)
+         ztmp = ztmp*ztmp
+         psi_unst = LOG( 0.125_wp*ztmp*(1._wp + zx) )   &
+            &       -2._wp*ATAN( SQRT(zx) ) + 0.5_wp*rpi
+         !
+         ! Unstable:
+         ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1
+         psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) &
+            &       - zzeta - 2._wp/3._wp*5._wp/0.35_wp
+         !
+         ! Combining:
+         stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1
+         !
+         psi_m_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable
+            &                +      stab  * psi_stab      ! (zzeta > 0) Stable
+         !
+      END_2D
    END FUNCTION psi_m_ecmwf
 
-   
+
    FUNCTION psi_h_ecmwf( pzeta )
       !!----------------------------------------------------------------------------------
@@ -342 +448 @@
       !!         and L is M-O length
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
       !!----------------------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ecmwf
@@ -351 +457 @@
       !!----------------------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zzeta = MIN(pzeta(ji,jj) , 5.)   ! Very stable conditions (L positif and big!):
-            !
-            zx  = ABS(1. - 16.*zzeta)**.25        ! this is actually (1/phi_m)**2  !!!
-            !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1
-            ! Unstable (Paulson 1970) :
-            psi_unst = 2.*LOG(0.5*(1. + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
-            !
-            ! Stable:
-            psi_stab = -2./3.*(zzeta - 5./0.35)*EXP(-0.35*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1
-               &       - ABS(1. + 2./3.*zzeta)**1.5 - 2./3.*5./0.35 + 1. 
-            ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution...
-            !
-            stab = 0.5 + SIGN(0.5, zzeta) ! zzeta > 0 => stab = 1
-            !
-            !
-            psi_h_ecmwf(ji,jj) = (1. - stab) * psi_unst &   ! (zzeta < 0) Unstable
-               &                +    stab    * psi_stab     ! (zzeta > 0) Stable
-            !
-         END DO
-      END DO
-      !
+      DO_2D_11_11
+         !
+         zzeta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!):
+         !
+         zx  = ABS(1._wp - 16._wp*zzeta)**.25        ! this is actually (1/phi_m)**2  !!!
+         !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1
+         ! Unstable (Paulson 1970) :
+         psi_unst = 2._wp*LOG(0.5_wp*(1._wp + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
+         !
+         ! Stable:
+         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
+            &       - ABS(1._wp + 2._wp/3._wp*zzeta)**1.5_wp - 2._wp/3._wp*5._wp/0.35_wp + 1._wp
+         ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution...
+         !
+         stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1
+         !
+         !
+         psi_h_ecmwf(ji,jj) = (1._wp - stab) * psi_unst &   ! (zzeta < 0) Unstable
+            &                +    stab    * psi_stab        ! (zzeta > 0) Stable
+         !
+      END_2D
    END FUNCTION psi_h_ecmwf
 
-
-   FUNCTION Ri_bulk( pz, ptz, pdt, pqz, pdq, pub )
-      !!----------------------------------------------------------------------------------
-      !! Bulk Richardson number (Eq. 3.25 IFS doc)
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj) ::   Ri_bulk   !
-      !
-      REAL(wp)                    , INTENT(in) ::   pz    ! height above the sea        [m]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptz   ! air temperature at pz m     [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pdt   ! ptz - sst                   [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqz   ! air temperature at pz m [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pdq   ! pqz - ssq               [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pub   ! bulk wind speed           [m/s]
-      !!----------------------------------------------------------------------------------
-      !
-      Ri_bulk =   grav*pz/(pub*pub)                                          &
-         &      * ( pdt/(ptz - 0.5_wp*(pdt + grav*pz/(Cp_dry+Cp_vap*pqz)))   &
-         &          + rctv0*pdq )
-      !
-   END FUNCTION Ri_bulk
-
-
-   FUNCTION visc_air(ptak)
-      !!----------------------------------------------------------------------------------
-      !! Air kinetic viscosity (m^2/s) given from temperature in degrees...
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj)             ::   visc_air   !
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak       ! air temperature in (K)
-      !
-      INTEGER  ::   ji, jj      ! dummy loop indices
-      REAL(wp) ::   ztc, ztc2   ! local scalar
-      !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ztc  = ptak(ji,jj) - rt0   ! air temp, in deg. C
-            ztc2 = ztc*ztc
-            visc_air(ji,jj) = 1.326e-5*(1. + 6.542E-3*ztc + 8.301e-6*ztc2 - 4.84e-9*ztc2*ztc)
-         END DO
-      END DO
-      !
-   END FUNCTION visc_air
 
    !!======================================================================

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

@@ -11 +11 @@
    !!
    !!       Routine turb_ncar maintained and developed in AeroBulk
-   !!                     (http://aerobulk.sourceforge.net/)
+   !!                     (https://github.com/brodeau/aerobulk/)
    !!
    !!                         L. Brodeau, 2015
@@ -38 +38 @@
    USE lib_fortran     ! to use key_nosignedzero
 
+   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC ::   TURB_NCAR   ! called by sbcblk.F90
-
-   !                              ! NCAR own values for given constants:
-   REAL(wp), PARAMETER ::   rctv0 = 0.608   ! constant to obtain virtual temperature...
-   
+   PUBLIC :: TURB_NCAR   ! called by sbcblk.F90
+
+   INTEGER , PARAMETER ::   nb_itt = 5        ! number of itterations
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+
    !!----------------------------------------------------------------------
 CONTAINS
@@ -61 +63 @@
       !!                Returns the effective bulk wind speed at 10m to be used in the bulk formulas
       !!
-      !! ** Method : Monin Obukhov Similarity Theory
-      !!             + Large & Yeager (2004,2008) closure: CD_n10 = f(U_n10)
-      !!
-      !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008
-      !!
-      !! ** Last update: Laurent Brodeau, June 2014:
-      !!    - handles both cases zt=zu and zt/=zu
-      !!    - optimized: less 2D arrays allocated and less operations
-      !!    - better first guess of stability by checking air-sea difference of virtual temperature
-      !!       rather than temperature difference only...
-      !!    - added function "cd_neutral_10m" that uses the improved parametrization of
-      !!      Large & Yeager 2008. Drag-coefficient reduction for Cyclone conditions!
-      !!    - using code-wide physical constants defined into "phycst.mod" rather than redifining them
-      !!      => 'vkarmn' and 'grav'
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
       !!
       !! INPUT :
       !! -------
       !!    *  zt   : height for temperature and spec. hum. of air            [m]
-      !!    *  zu   : height for wind speed (generally 10m)                   [m]
-      !!    *  U_zu : scalar wind speed at 10m                                [m/s]
-      !!    *  sst  : SST                                                     [K]
+      !!    *  zu   : height for wind speed (usually 10m)                     [m]
+      !!    *  sst  : bulk SST                                                [K]
       !!    *  t_zt : potential air temperature at zt                         [K]
       !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg]
       !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
+      !!    *  U_zu : scalar wind speed at zu                                 [m/s]
       !!
       !!
@@ -96 +82 @@
       !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
       !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
-      !!    *  U_blk  : bulk wind at 10m                                      [m/s]
+      !!    *  U_blk  : bulk wind speed at zu                                 [m/s]
+      !!
+      !!
+      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
       !!----------------------------------------------------------------------------------
       REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m]
@@ -103 +92 @@
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
@@ -110 +99 @@
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
       !
-      INTEGER ::   j_itt
-      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
-      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations
+      INTEGER :: j_itt
+      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
       !
       REAL(wp), DIMENSION(jpi,jpj) ::   Cx_n10        ! 10m neutral latent/sensible coefficient
@@ -126 +114 @@
       !
       l_zt_equal_zu = .FALSE.
-      IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
-
-      U_blk = MAX( 0.5 , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s
+      IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
+
+      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
 
       !! First guess of stability:
-      ztmp0 = t_zt*(1. + rctv0*q_zt) - sst*(1. + rctv0*ssq) ! air-sea difference of virtual pot. temp. at zt
-      stab  = 0.5 + sign(0.5,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable
+      ztmp0 = virt_temp(t_zt, q_zt) - virt_temp(sst, ssq) ! air-sea difference of virtual pot. temp. at zt
+      stab  = 0.5_wp + sign(0.5_wp,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable
 
       !! Neutral coefficients at 10m:
@@ -139 +127 @@
          ztmp0   (:,:) = cdn_wave(:,:)
       ELSE
-         ztmp0 = cd_neutral_10m( U_blk )
+      ztmp0 = cd_neutral_10m( U_blk )
       ENDIF
 
@@ -146 +134 @@
       !! Initializing transf. coeff. with their first guess neutral equivalents :
       Cd = ztmp0
-      Ce = 1.e-3*( 34.6 * sqrt_Cd_n10 )
-      Ch = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))
+      Ce = 1.e-3_wp*( 34.6_wp * sqrt_Cd_n10 )
+      Ch = 1.e-3_wp*sqrt_Cd_n10*(18._wp*stab + 32.7_wp*(1._wp - stab))
       stab = sqrt_Cd_n10   ! Temporaty array !!! stab == SQRT(Cd)
  
-      IF( ln_cdgw )   Cen = Ce  ; Chn = Ch
+      IF( ln_cdgw ) THEN
+   Cen = Ce
+   Chn = Ch
+      ENDIF
 
       !! Initializing values at z_u with z_t values:
       t_zu = t_zt   ;   q_zu = q_zt
 
-      !!  * Now starting iteration loop
-      DO j_itt=1, nb_itt
+      !! ITERATION BLOCK
+      DO j_itt = 1, nb_itt
          !
          ztmp1 = t_zu - sst   ! Updating air/sea differences
@@ -162 +153 @@
 
          ! Updating turbulent scales :   (L&Y 2004 eq. (7))
-         ztmp1  = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd))
-         ztmp2  = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd))
-
-         ztmp0 = 1. + rctv0*q_zu      ! multiply this with t and you have the virtual temperature
+         ztmp0 = stab*U_blk       ! u*       (stab == SQRT(Cd))
+         ztmp1 = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd))
+         ztmp2 = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd))
 
          ! Estimate the inverse of Monin-Obukov length (1/L) at height zu:
-         ztmp0 =  (grav*vkarmn/(t_zu*ztmp0)*(ztmp1*ztmp0 + rctv0*t_zu*ztmp2)) / (Cd*U_blk*U_blk)
-         !                                                      ( Cd*U_blk*U_blk is U*^2 at zu )
-
+         ztmp0 = One_on_L( t_zu, q_zu, ztmp0, ztmp1, ztmp2 )
+         
          !! Stability parameters :
-         zeta_u   = zu*ztmp0   ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u )
+         zeta_u   = zu*ztmp0
+         zeta_u = sign( min(abs(zeta_u),10._wp), zeta_u )
          zpsi_h_u = psi_h( zeta_u )
 
@@ -178 +168 @@
          IF( .NOT. l_zt_equal_zu ) THEN
             !! Array 'stab' is free for the moment so using it to store 'zeta_t'
-            stab = zt*ztmp0 ;  stab = SIGN( MIN(ABS(stab),10.0), stab )  ! Temporaty array stab == zeta_t !!!
+            stab = zt*ztmp0
+            stab = SIGN( MIN(ABS(stab),10._wp), stab )  ! Temporaty array stab == zeta_t !!!
             stab = LOG(zt/zu) + zpsi_h_u - psi_h(stab)                   ! stab just used as temp array again!
             t_zu = t_zt - ztmp1/vkarmn*stab    ! ztmp1 is still theta*  L&Y 2004 eq.(9b)
             q_zu = q_zt - ztmp2/vkarmn*stab    ! ztmp2 is still q*      L&Y 2004 eq.(9c)
-            q_zu = max(0., q_zu)
-         END IF
-
+            q_zu = max(0._wp, q_zu)
+         ENDIF
+
+         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)...
+         !   In very rare low-wind conditions, the old way of estimating the
+         !   neutral wind speed at 10m leads to a negative value that causes the code
+         !   to crash. To prevent this a threshold of 0.25m/s is imposed.
          ztmp2 = psi_m(zeta_u)
          IF( ln_cdgw ) THEN      ! surface wave case
             stab = vkarmn / ( vkarmn / sqrt_Cd_n10 - ztmp2 )  ! (stab == SQRT(Cd))
             Cd   = stab * stab
-            ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
+            ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
             ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd))
-            ztmp1 = 1. + Chn * ztmp0     
+            ztmp1 = 1._wp + Chn * ztmp0     
             Ch    = Chn * ztmp2 / ztmp1  ! L&Y 2004 eq. (10b)
-            ztmp1 = 1. + Cen * ztmp0
+            ztmp1 = 1._wp + Cen * ztmp0
             Ce    = Cen * ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
 
          ELSE
-            ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)...
-            !   In very rare low-wind conditions, the old way of estimating the
-            !   neutral wind speed at 10m leads to a negative value that causes the code
-            !   to crash. To prevent this a threshold of 0.25m/s is imposed.
-            ztmp0 = MAX( 0.25 , U_blk/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u))
-            ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10
-            Cdn(:,:) = ztmp0
-            sqrt_Cd_n10 = sqrt(ztmp0)
-
-            stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability
-            Cx_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10)
-            Chn(:,:) = Cx_n10
-
-            !! Update of transfer coefficients:
-            ztmp1 = 1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u))
-            Cd      = ztmp0 / ( ztmp1*ztmp1 )
-            stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd))
-
-            ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
-            ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd))
-            ztmp1 = 1. + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10)
-            Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b)
-
-            Cx_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10
-            Cen(:,:) = Cx_n10
-            ztmp1 = 1. + Cx_n10*ztmp0
-            Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
-            ENDIF
-         !
-      END DO
-      !
+         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)...
+         !   In very rare low-wind conditions, the old way of estimating the
+         !   neutral wind speed at 10m leads to a negative value that causes the code
+         !   to crash. To prevent this a threshold of 0.25m/s is imposed.
+         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))
+         ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10
+         Cdn(:,:) = ztmp0
+         sqrt_Cd_n10 = sqrt(ztmp0)
+
+         stab    = 0.5_wp + sign(0.5_wp,zeta_u)                        ! update stability
+         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)
+         Chn(:,:) = Cx_n10
+
+         !! Update of transfer coefficients:
+         ztmp1 = 1._wp + sqrt_Cd_n10/vkarmn*(LOG(zu/10._wp) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u))
+         Cd      = ztmp0 / ( ztmp1*ztmp1 )
+         stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd))
+
+         ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
+         ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd))
+         ztmp1 = 1._wp + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10)
+         Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b)
+
+         Cx_n10  = 1.e-3_wp * (34.6_wp * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10
+         Cen(:,:) = Cx_n10
+         ztmp1 = 1._wp + Cx_n10*ztmp0
+         Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
+         ENDIF
+
+      END DO !DO j_itt = 1, nb_itt
+
    END SUBROUTINE turb_ncar
 
@@ -238 +233 @@
       !! Origin: Large & Yeager 2008 eq.(11a) and eq.(11b)
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
       !!----------------------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pw10           ! scalar wind speed at 10m (m/s)
@@ -247 +242 @@
       !!----------------------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            zw  = pw10(ji,jj)
-            zw6 = zw*zw*zw
-            zw6 = zw6*zw6
-            !
-            ! When wind speed > 33 m/s => Cyclone conditions => special treatment
-            zgt33 = 0.5 + SIGN( 0.5, (zw - 33.) )   ! If pw10 < 33. => 0, else => 1
-            !
-            cd_neutral_10m(ji,jj) = 1.e-3 * ( &
-               &       (1. - zgt33)*( 2.7/zw + 0.142 + zw/13.09 - 3.14807E-10*zw6) & ! wind <  33 m/s
-               &      +    zgt33   *      2.34 )                                     ! wind >= 33 m/s
-            !
-            cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6)
-            !
-         END DO
-      END DO
+      DO_2D_11_11
+         !
+         zw  = pw10(ji,jj)
+         zw6 = zw*zw*zw
+         zw6 = zw6*zw6
+         !
+         ! When wind speed > 33 m/s => Cyclone conditions => special treatment
+         zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1
+         !
+         cd_neutral_10m(ji,jj) = 1.e-3_wp * ( &
+            &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s
+            &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s
+         !
+         cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6_wp)
+         !
+      END_2D
       !
    END FUNCTION cd_neutral_10m
@@ -273 +266 @@
       !! Universal profile stability function for momentum
       !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e)
-      !!     
-      !! pzet0 : stability paramenter, z/L where z is altitude measurement                                          
+      !!
+      !! pzeta : stability paramenter, z/L where z is altitude measurement
       !!         and L is M-O length
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pzeta
-      REAL(wp), DIMENSION(jpi,jpj)             ::   psi_m
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_m
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
       REAL(wp) :: zx2, zx, zstab   ! local scalars
       !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) )
-            zx2 = MAX ( zx2 , 1. )
-            zx  = SQRT( zx2 )
-            zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) )
-            !
-            psi_m(ji,jj) =        zstab  * (-5.*pzeta(ji,jj))       &          ! Stable
-               &          + (1. - zstab) * (2.*LOG((1. + zx)*0.5)   &          ! Unstable
-               &               + LOG((1. + zx2)*0.5) - 2.*ATAN(zx) + rpi*0.5)  !    "
-            !
-         END DO
-      END DO
-      !
+      DO_2D_11_11
+         zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) )
+         zx2 = MAX( zx2 , 1._wp )
+         zx  = SQRT( zx2 )
+         zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) )
+         !
+         psi_m(ji,jj) =        zstab  * (-5._wp*pzeta(ji,jj))       &          ! Stable
+            &          + (1._wp - zstab) * (2._wp*LOG((1._wp + zx)*0.5_wp)   &          ! Unstable
+            &               + LOG((1._wp + zx2)*0.5_wp) - 2._wp*ATAN(zx) + rpi*0.5_wp)  !    "
+         !
+      END_2D
    END FUNCTION psi_m
 
@@ -308 +297 @@
       !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e)
       !!
-      !! pzet0 : stability paramenter, z/L where z is altitude measurement                                          
+      !! pzeta : stability paramenter, z/L where z is altitude measurement
       !!         and L is M-O length
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_h
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
-      REAL(wp), DIMENSION(jpi,jpj)             :: psi_h
-      !
-      INTEGER  ::   ji, jj    ! dummy loop indices
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
       REAL(wp) :: zx2, zstab  ! local scalars
       !!----------------------------------------------------------------------------------
       !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) )
-            zx2 = MAX ( zx2 , 1. )
-            zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) )
-            !
-            psi_h(ji,jj) =         zstab  * (-5.*pzeta(ji,jj))        &  ! Stable
-               &           + (1. - zstab) * (2.*LOG( (1. + zx2)*0.5 ))   ! Unstable
-            !
-         END DO
-      END DO
-      !
+      DO_2D_11_11
+         zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) )
+         zx2 = MAX( zx2 , 1._wp )
+         zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) )
+         !
+         psi_h(ji,jj) =         zstab  * (-5._wp*pzeta(ji,jj))        &  ! Stable
+            &           + (1._wp - zstab) * (2._wp*LOG( (1._wp + zx2)*0.5_wp ))   ! Unstable
+         !
+      END_2D
    END FUNCTION psi_h
 

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

@@ -27 +27 @@
    USE sbcwave         ! surface boundary condition: waves
    USE phycst          ! physical constants
+   USE isf_oce , ONLY : l_isfoasis, fwfisf_oasis ! ice shelf boundary condition
 #if defined key_si3
    USE ice            ! ice variables
@@ -32 +33 @@
    USE cpl_oasis3     ! OASIS3 coupling
    USE geo2ocean      ! 
-   USE oce     , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
+   USE oce     , ONLY : ts, uu, vv, ssh, fraqsr_1lev
    USE ocealb         ! 
    USE eosbn2         ! 
    USE sbcrnf  , ONLY : l_rnfcpl
-   USE sbcisf  , ONLY : l_isfcpl
 #if defined key_cice
    USE ice_domain_size, only: ncat
@@ -198 +198 @@
 
    !! Substitution
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -264 +264 @@
       ! ================================ !
       !
-      REWIND( numnam_ref )              ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling
       READ  ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist' )
       !
-      REWIND( numnam_cfg )              ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling
       READ  ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist' )
@@ -453 +451 @@
       CASE( 'conservative'  )
          srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
-         IF ( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE.
+         IF( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE.
       CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE.
       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
@@ -474 +472 @@
       srcv(jpr_icb)%clname = 'OIceberg'   ;  IF( TRIM( sn_rcv_icb%cldes) == 'coupled' )   srcv(jpr_icb)%laction = .TRUE.
 
-      IF( srcv(jpr_isf)%laction .AND. ln_isf ) THEN
-         l_isfcpl             = .TRUE.                      ! -> no need to read isf in sbcisf
+      IF( srcv(jpr_isf)%laction ) THEN
+         l_isfoasis = .TRUE.  ! -> isf fwf comes from oasis
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '   iceshelf received from oasis '
+         CALL ctl_stop('STOP','not coded')
       ENDIF
       !
@@ -533 +532 @@
       !                                                      ! ------------------------- !
       srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE.
-      lhftau = srcv(jpr_taum)%laction
       !
       !                                                      ! ------------------------- !
@@ -558 +556 @@
       srcv(jpr_botm )%clname = 'OBotMlt'
       IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN
-         IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
+         IF( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
             srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl
          ELSE
@@ -569 +567 @@
       !                                                      ! ------------------------- !
       srcv(jpr_ts_ice)%clname = 'OTsfIce'    ! needed by Met Office
-      IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE.
-      IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl
-      IF ( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl
+      IF( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE.
+      IF( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl
+      IF( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl
 
 #if defined key_si3
@@ -699 +697 @@
          ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere
          DO jn = 1, jprcv
-            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
+            IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
          END DO
          !
@@ -726 +724 @@
       ! =================================================== !
       DO jn = 1, jprcv
-         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
+         IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
       END DO
       ! Allocate taum part of frcv which is used even when not received as coupling field
-      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
+      IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
       ! Allocate w10m part of frcv which is used even when not received as coupling field
-      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
+      IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
       ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
-      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
-      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
+      IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
+      IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
       ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
       IF( k_ice /= 0 ) THEN
-         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
-         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
-      END IF
+         IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
+         IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
+      ENDIF
 
       ! ================================ !
@@ -763 +761 @@
       CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' )
          ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
-         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl
+         IF( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl
       CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE.
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
@@ -783 +781 @@
       !     1. sending mixed oce-ice albedo or
       !     2. receiving mixed oce-ice solar radiation 
-      IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
+      IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
          CALL oce_alb( zaos, zacs )
          ! Due to lack of information on nebulosity : mean clear/overcast sky
@@ -802 +800 @@
          ssnd(jps_fice1)%laction = .TRUE.                 ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement)
 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now
-         IF ( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl
-         IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl
+         IF( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl
+         IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl
       ENDIF
       
-      IF (TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 
+      IF(TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 
 
       SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
@@ -812 +810 @@
       CASE( 'ice and snow' ) 
          ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
-         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
+         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
             ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
          ENDIF
       CASE ( 'weighted ice and snow' ) 
          ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
-         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
+         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' )
       END SELECT
@@ -834 +832 @@
          ssnd(jps_a_p)%laction  = .TRUE. 
          ssnd(jps_ht_p)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
+         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
             ssnd(jps_a_p)%nct  = nn_cats_cpl 
             ssnd(jps_ht_p)%nct = nn_cats_cpl 
          ELSE 
-            IF ( nn_cats_cpl > 1 ) THEN 
+            IF( nn_cats_cpl > 1 ) THEN 
                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 
             ENDIF 
@@ -845 +843 @@
          ssnd(jps_a_p)%laction  = .TRUE. 
          ssnd(jps_ht_p)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
+         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
             ssnd(jps_a_p)%nct  = nn_cats_cpl  
             ssnd(jps_ht_p)%nct = nn_cats_cpl  
@@ -919 +917 @@
       CASE ( 'ice only' ) 
          ssnd(jps_ttilyr)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 
+         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 
             ssnd(jps_ttilyr)%nct = nn_cats_cpl 
          ELSE 
-            IF ( nn_cats_cpl > 1 ) THEN 
+            IF( nn_cats_cpl > 1 ) THEN 
                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 
             ENDIF 
@@ -928 +926 @@
       CASE ( 'weighted ice' ) 
          ssnd(jps_ttilyr)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 
+         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 
       END SELECT 
@@ -938 +936 @@
       CASE ( 'ice only' ) 
          ssnd(jps_kice)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 
+         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 
             ssnd(jps_kice)%nct = nn_cats_cpl 
          ELSE 
-            IF ( nn_cats_cpl > 1 ) THEN 
+            IF( nn_cats_cpl > 1 ) THEN 
                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 
             ENDIF 
@@ -947 +945 @@
       CASE ( 'weighted ice' ) 
          ssnd(jps_kice)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 
+         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 
       END SELECT 
@@ -1008 +1006 @@
          ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
          DO jn = 1, jpsnd
-            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
+            IF( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
          END DO
          !
@@ -1035 +1033 @@
       CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
       
-      IF (ln_usecplmask) THEN 
+      IF(ln_usecplmask) THEN 
          xcplmask(:,:,:) = 0.
          CALL iom_open( 'cplmask', inum )
@@ -1049 +1047 @@
 
 
-   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )     
+   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm )     
       !!----------------------------------------------------------------------
       !!             ***  ROUTINE sbc_cpl_rcv  ***
@@ -1099 +1097 @@
       INTEGER, INTENT(in) ::   k_fsbc      ! frequency of sbc (-> ice model) computation 
       INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3)
+      INTEGER, INTENT(in) ::   Kbb, Kmm    ! ocean model time level indices
       !!
       LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module??
@@ -1166 +1165 @@
             !                              
             IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
-               DO jj = 2, jpjm1                                          ! T ==> (U,V)
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
-                     frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
-                  END DO
-               END DO
+               DO_2D_00_00
+                  frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
+                  frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
+               END_2D
                CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U',  -1., frcv(jpr_oty1)%z3(:,:,1), 'V',  -1. )
             ENDIF
@@ -1192 +1189 @@
          ! => need to be done only when otx1 was changed
          IF( llnewtx ) THEN
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vect. opt.
-                  zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
-                  zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
-                  frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
-               END DO
-            END DO
+            DO_2D_00_00
+               zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
+               zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
+               frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
+            END_2D
             CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. )
             llnewtau = .TRUE.
@@ -1219 +1214 @@
          IF( llnewtau ) THEN 
             zcoef = 1. / ( zrhoa * zcdrag ) 
-            DO jj = 1, jpj
-               DO ji = 1, jpi 
-                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
-               END DO
-            END DO
+            DO_2D_11_11
+               frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
+            END_2D
          ENDIF
       ENDIF
@@ -1262 +1255 @@
     
           IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible) 
-      END IF 
+      ENDIF 
       !
       IF( ln_sdw ) THEN  ! Stokes Drift correction activated
@@ -1298 +1291 @@
          IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction &
                                       .OR. srcv(jpr_hsig)%laction   .OR. srcv(jpr_wfreq)%laction) THEN
-            CALL sbc_stokes()
+            CALL sbc_stokes( Kmm )
          ENDIF
       ENDIF
@@ -1350 +1343 @@
       IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
          ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
-         ub (:,:,1) = ssu_m(:,:)                             ! will be used in icestp in the call of ice_forcing_tau
-         un (:,:,1) = ssu_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
+         uu(:,:,1,Kbb) = ssu_m(:,:)                          ! will be used in icestp in the call of ice_forcing_tau
+         uu(:,:,1,Kmm) = ssu_m(:,:)                          ! will be used in sbc_cpl_snd if atmosphere coupling
          CALL iom_put( 'ssu_m', ssu_m )
       ENDIF
       IF( srcv(jpr_ocy1)%laction ) THEN
          ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
-         vb (:,:,1) = ssv_m(:,:)                             ! will be used in icestp in the call of ice_forcing_tau
-         vn (:,:,1) = ssv_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
+         vv(:,:,1,Kbb) = ssv_m(:,:)                          ! will be used in icestp in the call of ice_forcing_tau
+         vv(:,:,1,Kmm) = ssv_m(:,:)                          ! will be used in sbc_cpl_snd if atmosphere coupling
          CALL iom_put( 'ssv_m', ssv_m )
       ENDIF
@@ -1401 +1394 @@
              rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runfofs
          ENDIF
-         IF( srcv(jpr_isf)%laction )  fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)  
+         !
+         ! ice shelf fwf
+         IF( srcv(jpr_isf)%laction )  THEN
+            fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)  
+         END IF
         
          IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
@@ -1411 +1408 @@
          ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
          ELSE                                       ;   zqns(:,:) = 0._wp
-         END IF
+         ENDIF
          ! update qns over the free ocean with:
          IF( nn_components /= jp_iam_opa ) THEN
@@ -1546 +1543 @@
             p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
          CASE( 'F' )
-            DO jj = 2, jpjm1                                   ! F ==> (U,V)
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj-1,1) )
-                  p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1) )
-               END DO
-            END DO
+            DO_2D_00_00
+               p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj-1,1) )
+               p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1) )
+            END_2D
          CASE( 'T' )
-            DO jj = 2, jpjm1                                   ! T ==> (U,V)
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
-                  p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
-               END DO
-            END DO
+            DO_2D_00_00
+               p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
+               p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
+            END_2D
          CASE( 'I' )
-            DO jj = 2, jpjm1                                   ! I ==> (U,V)
-               DO ji = 2, jpim1   ! NO vector opt.
-                  p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1) )
-                  p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji  ,jj+1,1) )
-               END DO
-            END DO
+            DO_2D_00_00
+               p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1) )
+               p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji  ,jj+1,1) )
+            END_2D
          END SELECT
          IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN 
@@ -1683 +1674 @@
       ! --- evaporation over ice (kg/m2/s) --- !
       DO jl=1,jpl
-         IF (sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl)
+         IF(sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl)
          ELSE                                  ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 )   ;   ENDIF
       ENDDO
@@ -1704 +1695 @@
       ENDIF
       IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting)
-        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  
+        fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)  
       ENDIF
 
@@ -1743 +1734 @@
       ENDIF
       IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting)
-        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
+        fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)
       ENDIF
       !
@@ -1765 +1756 @@
       IF( srcv(jpr_cal)%laction )   CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1)                )  ! calving
       IF( srcv(jpr_icb)%laction )   CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1)                )  ! icebergs
-      CALL iom_put( 'snowpre'     , sprecip(:,:)                                          )  ! Snow
-      CALL iom_put( 'precip'      , tprecip(:,:)                                          )  ! total  precipitation
-      IF ( iom_use('rain') ) CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation 
-      IF ( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average)
-      IF ( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average)
-      IF ( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:)         )  ! liquid precipitation over ocean (cell average)
-      IF ( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average)
-      IF ( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  &
+      IF( iom_use('snowpre') )      CALL iom_put( 'snowpre'     , sprecip(:,:)                                          )  ! Snow
+      IF( iom_use('precip') )       CALL iom_put( 'precip'      , tprecip(:,:)                                          )  ! total  precipitation
+      IF( iom_use('rain') )         CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation 
+      IF( iom_use('snow_ao_cea') )  CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average)
+      IF( iom_use('snow_ai_cea') )  CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average)
+      IF( iom_use('rain_ao_cea') )  CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:)         )  ! liquid precipitation over ocean (cell average)
+      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average)
+      IF( iom_use('evap_ao_cea') )  CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  &
          &                                                        - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) )  ! ice-free oce evap (cell average)
       ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
@@ -1783 +1774 @@
       CASE( 'conservative' )     ! the required fields are directly provided
          zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
-         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
             zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
          ELSE
@@ -1792 +1783 @@
       CASE( 'oce and ice' )      ! the total flux is computed from ocean and ice fluxes
          zqns_tot(:,:) =  ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
-         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
             DO jl=1,jpl
                zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
@@ -1904 +1895 @@
 #endif
       ! outputs
-      IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )   ! latent heat from calving
-      IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )   ! latent heat from icebergs melting
-      IF ( iom_use(   'hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average)
-      IF ( iom_use(   'hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) )  &
-           &                         * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average)
-      IF ( iom_use(   'hflx_prec_cea') ) CALL iom_put('hflx_prec_cea' ,    sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  &                    ! heat flux from all precip (cell avg)
-         &                          + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
-      IF ( iom_use(   'hflx_snow_cea') ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average)
-      IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) * ( 1._wp - zsnw(:,:) ) )   ! heat flux from snow (over ocean)
-      IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) *  zsnw(:,:) )              ! heat flux from snow (over ice)
+      IF( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )                      ! latent heat from calving
+      IF( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting
+      IF( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average)
+      IF( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) &
+           &                                                              * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average)
+      IF( iom_use('hflx_prec_cea')    ) CALL iom_put('hflx_prec_cea'   ,  sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) +  &                    ! heat flux from all precip (cell avg)
+         &                                                               ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
+      IF( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average)
+      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
+           &                                                              * ( 1._wp - zsnw(:,:) )                  )               ! heat flux from snow (over ocean)
+      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
+           &                                                              *           zsnw(:,:)                    )               ! heat flux from snow (over ice)
       ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
       !
@@ -1923 +1916 @@
       CASE( 'conservative' )
          zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
-         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
             zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
          ELSE
@@ -1933 +1926 @@
       CASE( 'oce and ice' )
          zqsr_tot(:,:  ) =  ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
-         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
             DO jl = 1, jpl
                zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
@@ -1999 +1992 @@
       !                                                      ! ========================= !
       CASE ('coupled')
-         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
             zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
          ELSE
@@ -2088 +2081 @@
    
    
-   SUBROUTINE sbc_cpl_snd( kt )
+   SUBROUTINE sbc_cpl_snd( kt, Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!             ***  ROUTINE sbc_cpl_snd  ***
@@ -2098 +2091 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt
+      INTEGER, INTENT(in) ::   Kbb, Kmm    ! ocean model time level index
       !
       INTEGER ::   ji, jj, jl   ! dummy loop indices
@@ -2114 +2108 @@
       IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
          
-         IF ( nn_components == jp_iam_opa ) THEN
-            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
+         IF( nn_components == jp_iam_opa ) THEN
+            ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
          ELSE
             ! we must send the surface potential temperature 
-            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
-            ELSE                   ;   ztmp1(:,:) = tsn(:,:,1,jp_tem)
+            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) )
+            ELSE                   ;   ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)
             ENDIF
             !
@@ -2147 +2141 @@
                CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
                END SELECT
-            CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0  
+            CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   ts(:,:,1,jp_tem,Kmm) + rt0  
                SELECT CASE( sn_snd_temp%clcat ) 
                CASE( 'yes' )    
@@ -2353 +2347 @@
       !                                                      !  CO2 flux from PISCES     ! 
       !                                                      ! ------------------------- !
-      IF( ssnd(jps_co2)%laction .AND. l_co2cpl )   THEN  
-         ztmp1(:,:) = oce_co2(:,:) * 1000.  ! conversion in molC/m2/s 
-         CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info ) 
-      ENDIF 
+      IF( ssnd(jps_co2)%laction .AND. l_co2cpl )   THEN 
+         ztmp1(:,:) = oce_co2(:,:) * 1000.  ! conversion in molC/m2/s
+         CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info )
+      ENDIF
       !
       !                                                      ! ------------------------- !
@@ -2371 +2365 @@
          !                                                               i      i+1 (for I)
          IF( nn_components == jp_iam_opa ) THEN
-            zotx1(:,:) = un(:,:,1)  
-            zoty1(:,:) = vn(:,:,1)  
+            zotx1(:,:) = uu(:,:,1,Kmm)  
+            zoty1(:,:) = vv(:,:,1,Kmm)  
          ELSE        
             SELECT CASE( TRIM( sn_snd_crt%cldes ) )
             CASE( 'oce only'             )      ! C-grid ==> T
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )
-                     zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) ) 
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) )
+                  zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji  ,jj-1,1,Kmm) ) 
+               END_2D
             CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T  
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)  
-                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)
-                     zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
-                     zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)  
+                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)
+                  zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  )     + u_ice(ji-1,jj    )     ) *  fr_i(ji,jj)
+                  zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  )     + v_ice(ji  ,jj-1  )     ) *  fr_i(ji,jj)
+               END_2D
                CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. )
             CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &
-                        &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
-                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &
-                        &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
-                  END DO
-               END DO
+               DO_2D_00_00
+                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   &
+                     &         + 0.5 * ( u_ice(ji,jj  )     + u_ice(ji-1,jj    )     ) *  fr_i(ji,jj)
+                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   &
+                     &         + 0.5 * ( v_ice(ji,jj  )     + v_ice(ji  ,jj-1  )     ) *  fr_i(ji,jj)
+               END_2D
             END SELECT
             CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.,  zoty1, ssnd(jps_ocy1)%clgrid, -1. )
@@ -2459 +2447 @@
           SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
           CASE( 'oce only'             )      ! C-grid ==> T 
-             DO jj = 2, jpjm1 
-                DO ji = fs_2, fs_jpim1   ! vector opt. 
-                   zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
-                   zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji , jj-1,1) )  
-                END DO 
-             END DO 
+             DO_2D_00_00
+                zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) ) 
+                zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) )  
+             END_2D
           CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T   
-             DO jj = 2, jpjm1 
-                DO ji = fs_2, fs_jpim1   ! vector opt. 
-                   zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
-                   zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
-                   zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
-                   zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
-                END DO
-             END DO
+             DO_2D_00_00
+                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   
+                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 
+                zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
+                zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
+             END_2D
              CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.,  zity1, 'T', -1. ) 
           CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T  
-             DO jj = 2, jpjm1 
-                DO ji = fs_2, fs_jpim1   ! vector opt. 
-                   zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
-                      &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
-                   zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
-                      &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
-                END DO
-             END DO
+             DO_2D_00_00
+                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   & 
+                   &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
+                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   & 
+                   &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
+             END_2D
           END SELECT
          CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1., zoty1, ssnd(jps_ocyw)%clgrid, -1. ) 
@@ -2522 +2504 @@
       IF( ssnd(jps_ficet)%laction ) THEN 
          CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 
-      END IF 
+      ENDIF 
       !                                                      ! ------------------------- ! 
       !                                                      !   Water levels to waves   ! 
@@ -2529 +2511 @@
          IF( ln_apr_dyn ) THEN  
             IF( kt /= nit000 ) THEN  
-               ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )  
+               ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )  
             ELSE  
-               ztmp1(:,:) = sshb(:,:)  
+               ztmp1(:,:) = ssh(:,:,Kbb)  
             ENDIF  
          ELSE  
-            ztmp1(:,:) = sshn(:,:)  
+            ztmp1(:,:) = ssh(:,:,Kmm)  
          ENDIF  
          CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
-      END IF 
+      ENDIF 
       !
       !  Fields sent by OPA to SAS when doing OPA<->SAS coupling
@@ -2544 +2526 @@
          !                          ! removed inverse barometer ssh when Patm
          !                          forcing is used (for sea-ice dynamics)
-         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
-         ELSE                    ;   ztmp1(:,:) = sshn(:,:)
+         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ztmp1(:,:) = ssh(:,:,Kmm)
          ENDIF
          CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info )
@@ -2552 +2534 @@
       !                                                        ! SSS
       IF( ssnd(jps_soce  )%laction )  THEN
-         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
+         CALL cpl_snd( jps_soce  , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info )
       ENDIF
       !                                                        ! first T level thickness 
       IF( ssnd(jps_e3t1st )%laction )  THEN
-         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1)   , (/jpi,jpj,1/) ), info )
+         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm)   , (/jpi,jpj,1/) ), info )
       ENDIF
       !                                                        ! Qsr fraction
@@ -2579 +2561 @@
       !                                                      ! ------------------------- !
       ! needed by Met Office
-      CALL eos_fzp(tsn(:,:,1,jp_sal), sstfrz)
+      CALL eos_fzp(ts(:,:,1,jp_sal,Kmm), sstfrz)
       ztmp1(:,:) = sstfrz(:,:) + rt0
       IF( ssnd(jps_sstfrz)%laction )  CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)

NEMO/trunk/src/OCE/SBC/sbcdcy.F90

@@ -7 +7 @@
    !!   NEMO    2.0  !  2006-02  (S. Masson, G. Madec)  adaptation to NEMO
    !!           3.1  !  2009-07  (J.M. Molines)  adaptation to v3.1
+   !!           4.*  !  2019-10  (L. Brodeau)  nothing really new, but the routine
+   !!                ! "sbc_dcy_param" has been extracted from old function "sbc_dcy"
+   !!                ! => this allows the warm-layer param of COARE3* to know the time
+   !!                ! of dawn and dusk even if "ln_dm2dc=.false." (rdawn_dcy & rdusk_dcy
+   !!                ! are now public)
    !!----------------------------------------------------------------------
 
@@ -22 +27 @@
    IMPLICIT NONE
    PRIVATE
-   
+
    INTEGER, PUBLIC ::   nday_qsr   !: day when parameters were computed
-   
+
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   raa , rbb  , rcc  , rab     ! diurnal cycle parameters
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rdawn, rdusk, rscal   !    -      -       -
-  
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rscal   !    -      -       -
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: rdawn_dcy, rdusk_dcy   !    -      -       -
+
    PUBLIC   sbc_dcy        ! routine called by sbc
-
+   PUBLIC   sbc_dcy_param  ! routine used here and called by warm-layer parameterization (sbcblk_skin_coare*)
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
 CONTAINS
 
-      INTEGER FUNCTION sbc_dcy_alloc()
-         !!----------------------------------------------------------------------
-         !!                ***  FUNCTION sbc_dcy_alloc  ***
-         !!----------------------------------------------------------------------
-         ALLOCATE( raa (jpi,jpj) , rbb  (jpi,jpj) , rcc  (jpi,jpj) , rab  (jpi,jpj) ,     &
-            &      rtmd(jpi,jpj) , rdawn(jpi,jpj) , rdusk(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc )
-            !
-         CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc )
-         IF( sbc_dcy_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' )
-      END FUNCTION sbc_dcy_alloc
+   INTEGER FUNCTION sbc_dcy_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION sbc_dcy_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( raa (jpi,jpj) , rbb  (jpi,jpj) , rcc  (jpi,jpj) , rab  (jpi,jpj) ,     &
+         &      rtmd(jpi,jpj) , rdawn_dcy(jpi,jpj) , rdusk_dcy(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc )
+      !
+      CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc )
+      IF( sbc_dcy_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' )
+   END FUNCTION sbc_dcy_alloc
 
 
@@ -60 +69 @@
       !!
       !! reference  : Bernie, DJ, E Guilyardi, G Madec, JM Slingo, and SJ Woolnough, 2007
-      !!              Impact of resolving the diurnal cycle in an ocean--atmosphere GCM. 
+      !!              Impact of resolving the diurnal cycle in an ocean--atmosphere GCM.
       !!              Part 1: a diurnally forced OGCM. Climate Dynamics 29:6, 575-590.
       !!----------------------------------------------------------------------
       LOGICAL , OPTIONAL          , INTENT(in) ::   l_mask    ! use the routine for night mask computation
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux
       REAL(wp), DIMENSION(jpi,jpj)             ::   zqsrout   ! output QSR flux with diurnal cycle
       !!
       INTEGER  ::   ji, jj                                       ! dummy loop indices
       INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask
-      REAL(wp) ::   ztwopi, zinvtwopi, zconvrad 
       REAL(wp) ::   zlo, zup, zlousd, zupusd
-      REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos
-      REAL(wp) ::   ztmp, ztmp1, ztmp2, ztest
+      REAL(wp) ::   ztmp, ztmp1, ztmp2
       REAL(wp) ::   ztmpm, ztmpm1, ztmpm2
-      !---------------------------statement functions------------------------
-      REAL(wp) ::   fintegral, pt1, pt2, paaa, pbbb, pccc        ! dummy statement function arguments
-      fintegral( pt1, pt2, paaa, pbbb, pccc ) =                         &
-         &   paaa * pt2 + zinvtwopi * pbbb * SIN(pccc + ztwopi * pt2)   &
-         & - paaa * pt1 - zinvtwopi * pbbb * SIN(pccc + ztwopi * pt1)
       !!---------------------------------------------------------------------
       !
       ! Initialization
       ! --------------
-      ztwopi    = 2._wp * rpi
-      zinvtwopi = 1._wp / ztwopi
-      zconvrad  = ztwopi / 360._wp
-
       ! When are we during the day (from 0 to 1)
       zlo = ( REAL(nsec_day, wp) - 0.5_wp * rdt ) / rday
       zup = zlo + ( REAL(nn_fsbc, wp)     * rdt ) / rday
-      !                                          
-      IF( nday_qsr == -1 ) THEN       ! first time step only  
+      !
+      IF( nday_qsr == -1 ) THEN       ! first time step only
          IF(lwp) THEN
             WRITE(numout,*)
@@ -98 +96 @@
             WRITE(numout,*)
          ENDIF
+      ENDIF
+
+      ! Setting parameters for each new day:
+      CALL sbc_dcy_param()
+
+      !CALL iom_put( "rdusk_dcy", rdusk_dcy(:,:)*tmask(:,:,1) ) !LB
+      !CALL iom_put( "rdawn_dcy", rdawn_dcy(:,:)*tmask(:,:,1) ) !LB
+      !CALL iom_put( "rscal_dcy", rscal(:,:)*tmask(:,:,1) ) !LB
+
+
+      !     3. update qsr with the diurnal cycle
+      !     ------------------------------------
+
+      imask_night(:,:) = 0
+      DO_2D_11_11
+         ztmpm = 0._wp
+         IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h
+            !
+            IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN       ! day time in one part
+               zlousd = MAX(zlo, rdawn_dcy(ji,jj))
+               zlousd = MIN(zlousd, zup)
+               zupusd = MIN(zup, rdusk_dcy(ji,jj))
+               zupusd = MAX(zupusd, zlo)
+               ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+               zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+               ztmpm = zupusd - zlousd
+               IF( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1
+               !
+            ELSE                                         ! day time in two parts
+               zlousd = MIN(zlo, rdusk_dcy(ji,jj))
+               zupusd = MIN(zup, rdusk_dcy(ji,jj))
+               ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+               ztmpm1=zupusd-zlousd
+               zlousd = MAX(zlo, rdawn_dcy(ji,jj))
+               zupusd = MAX(zup, rdawn_dcy(ji,jj))
+               ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+               ztmpm2 =zupusd-zlousd
+               ztmp = ztmp1 + ztmp2
+               ztmpm = ztmpm1 + ztmpm2
+               zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+               IF(ztmpm .EQ. 0.) imask_night(ji,jj) = 1
+            ENDIF
+         ELSE                                   ! 24h light or 24h night
+            !
+            IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day
+               ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+               zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+               imask_night(ji,jj) = 0
+               !
+            ELSE                                         ! No day
+               zqsrout(ji,jj) = 0.0_wp
+               imask_night(ji,jj) = 1
+            ENDIF
+         ENDIF
+      END_2D
+      !
+      IF( PRESENT(l_mask) .AND. l_mask ) THEN
+         zqsrout(:,:) = float(imask_night(:,:))
+      ENDIF
+      !
+   END FUNCTION sbc_dcy
+
+
+   SUBROUTINE sbc_dcy_param( )
+      !!
+      INTEGER  ::   ji, jj                                       ! dummy loop indices
+      !INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask
+      REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos
+      REAL(wp) ::   ztmp, ztest
+      !---------------------------statement functions------------------------
+      !
+      IF( nday_qsr == -1 ) THEN       ! first time step only
          ! allocate sbcdcy arrays
          IF( sbc_dcy_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc : unable to allocate arrays' )
          ! Compute rcc needed to compute the time integral of the diurnal cycle
-         rcc(:,:) = zconvrad * glamt(:,:) - rpi
+         rcc(:,:) = rad * glamt(:,:) - rpi
          ! time of midday
          rtmd(:,:) = 0.5_wp - glamt(:,:) / 360._wp
@@ -107 +177 @@
       ENDIF
 
-      ! If this is a new day, we have to update the dawn, dusk and scaling function  
+      ! If this is a new day, we have to update the dawn, dusk and scaling function
       !----------------------
-    
-      !     2.1 dawn and dusk  
-
-      ! nday is the number of days since the beginning of the current month 
-      IF( nday_qsr /= nday ) THEN 
+
+      !     2.1 dawn and dusk
+
+      ! nday is the number of days since the beginning of the current month
+      IF( nday_qsr /= nday ) THEN
          ! save the day of the year and the daily mean of qsr
-         nday_qsr = nday 
-         ! number of days since the previous winter solstice (supposed to be always 21 December)         
+         nday_qsr = nday
+         ! number of days since the previous winter solstice (supposed to be always 21 December)
          zdsws = REAL(11 + nday_year, wp)
          ! declination of the earths orbit
-         zdecrad = (-23.5_wp * zconvrad) * COS( zdsws * ztwopi / REAL(nyear_len(1),wp) )
+         zdecrad = (-23.5_wp * rad) * COS( zdsws * 2._wp*rpi / REAL(nyear_len(1),wp) )
          ! Compute A and B needed to compute the time integral of the diurnal cycle
 
          zsin = SIN( zdecrad )   ;   zcos = COS( zdecrad )
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztmp = zconvrad * gphit(ji,jj)
-               raa(ji,jj) = SIN( ztmp ) * zsin
-               rbb(ji,jj) = COS( ztmp ) * zcos
-            END DO  
-         END DO  
+         DO_2D_11_11
+            ztmp = rad * gphit(ji,jj)
+            raa(ji,jj) = SIN( ztmp ) * zsin
+            rbb(ji,jj) = COS( ztmp ) * zcos
+         END_2D
          ! Compute the time of dawn and dusk
 
-         ! rab to test if the day time is equal to 0, less than 24h of full day        
+         ! rab to test if the day time is equal to 0, less than 24h of full day
          rab(:,:) = -raa(:,:) / rbb(:,:)
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
-         ! When is it night?
-                  ztx = zinvtwopi * (ACOS(rab(ji,jj)) - rcc(ji,jj))
-                  ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + ztwopi * ztx )
-         ! is it dawn or dusk?
-                  IF ( ztest > 0._wp ) THEN
-                     rdawn(ji,jj) = ztx
-                     rdusk(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn(ji,jj) )
-                  ELSE
-                     rdusk(ji,jj) = ztx
-                     rdawn(ji,jj) = rtmd(ji,jj) - ( rdusk(ji,jj) - rtmd(ji,jj) )
-                  ENDIF
+         DO_2D_11_11
+            IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
+               ! When is it night?
+               ztx = 1._wp/(2._wp*rpi) * (ACOS(rab(ji,jj)) - rcc(ji,jj))
+               ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + 2._wp*rpi * ztx )
+               ! is it dawn or dusk?
+               IF( ztest > 0._wp ) THEN
+                  rdawn_dcy(ji,jj) = ztx
+                  rdusk_dcy(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn_dcy(ji,jj) )
                ELSE
-                  rdawn(ji,jj) = rtmd(ji,jj) + 0.5_wp
-                  rdusk(ji,jj) = rdawn(ji,jj)
+                  rdusk_dcy(ji,jj) = ztx
+                  rdawn_dcy(ji,jj) = rtmd(ji,jj) - ( rdusk_dcy(ji,jj) - rtmd(ji,jj) )
                ENDIF
-             END DO  
-         END DO  
-         rdawn(:,:) = MOD( (rdawn(:,:) + 1._wp), 1._wp )
-         rdusk(:,:) = MOD( (rdusk(:,:) + 1._wp), 1._wp )
+            ELSE
+               rdawn_dcy(ji,jj) = rtmd(ji,jj) + 0.5_wp
+               rdusk_dcy(ji,jj) = rdawn_dcy(ji,jj)
+            ENDIF
+         END_2D
+         rdawn_dcy(:,:) = MOD( (rdawn_dcy(:,:) + 1._wp), 1._wp )
+         rdusk_dcy(:,:) = MOD( (rdusk_dcy(:,:) + 1._wp), 1._wp )
          !     2.2 Compute the scaling function:
          !         S* = the inverse of the time integral of the diurnal cycle from dawn to dusk
          !         Avoid possible infinite scaling factor, associated with very short daylight
          !         periods, by ignoring periods less than 1/1000th of a day (ticket #1040)
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
-                  rscal(ji,jj) = 0.0_wp
-                  IF ( rdawn(ji,jj) < rdusk(ji,jj) ) THEN      ! day time in one part
-                     IF( (rdusk(ji,jj) - rdawn(ji,jj) ) .ge. 0.001_wp ) THEN
-                       rscal(ji,jj) = fintegral(rdawn(ji,jj), rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                       rscal(ji,jj) = 1._wp / rscal(ji,jj)
-                     ENDIF
-                  ELSE                                         ! day time in two parts
-                     IF( (rdusk(ji,jj) + (1._wp - rdawn(ji,jj)) ) .ge. 0.001_wp ) THEN
-                       rscal(ji,jj) = fintegral(0._wp, rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   &
-                          &         + fintegral(rdawn(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                       rscal(ji,jj) = 1. / rscal(ji,jj)
-                     ENDIF
+         DO_2D_11_11
+            IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
+               rscal(ji,jj) = 0.0_wp
+               IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN      ! day time in one part
+                  IF( (rdusk_dcy(ji,jj) - rdawn_dcy(ji,jj) ) .ge. 0.001_wp ) THEN
+                     rscal(ji,jj) = fintegral(rdawn_dcy(ji,jj), rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                     rscal(ji,jj) = 1._wp / rscal(ji,jj)
                   ENDIF
-               ELSE
-                  IF ( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day
-                     rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                     rscal(ji,jj) = 1._wp / rscal(ji,jj)
-                  ELSE                                          ! No day
-                     rscal(ji,jj) = 0.0_wp
+               ELSE                                         ! day time in two parts
+                  IF( (rdusk_dcy(ji,jj) + (1._wp - rdawn_dcy(ji,jj)) ) .ge. 0.001_wp ) THEN
+                     rscal(ji,jj) = fintegral(0._wp, rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   &
+                        &         + fintegral(rdawn_dcy(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                     rscal(ji,jj) = 1. / rscal(ji,jj)
                   ENDIF
                ENDIF
-            END DO  
-         END DO  
+            ELSE
+               IF( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day
+                  rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                  rscal(ji,jj) = 1._wp / rscal(ji,jj)
+               ELSE                                          ! No day
+                  rscal(ji,jj) = 0.0_wp
+               ENDIF
+            ENDIF
+         END_2D
          !
          ztmp = rday / ( rdt * REAL(nn_fsbc, wp) )
          rscal(:,:) = rscal(:,:) * ztmp
          !
-      ENDIF 
-         !     3. update qsr with the diurnal cycle
-         !     ------------------------------------
-
-      imask_night(:,:) = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ztmpm = 0._wp
-            IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h
-               !
-               IF( rdawn(ji,jj) < rdusk(ji,jj) ) THEN       ! day time in one part
-                  zlousd = MAX(zlo, rdawn(ji,jj))
-                  zlousd = MIN(zlousd, zup)
-                  zupusd = MIN(zup, rdusk(ji,jj))
-                  zupusd = MAX(zupusd, zlo)
-                  ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
-                  ztmpm = zupusd - zlousd
-                  IF ( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1
-                  !
-               ELSE                                         ! day time in two parts
-                  zlousd = MIN(zlo, rdusk(ji,jj))
-                  zupusd = MIN(zup, rdusk(ji,jj))
-                  ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                  ztmpm1=zupusd-zlousd
-                  zlousd = MAX(zlo, rdawn(ji,jj))
-                  zupusd = MAX(zup, rdawn(ji,jj))
-                  ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                  ztmpm2 =zupusd-zlousd
-                  ztmp = ztmp1 + ztmp2
-                  ztmpm = ztmpm1 + ztmpm2
-                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
-                  IF (ztmpm .EQ. 0.) imask_night(ji,jj) = 1
-               ENDIF
-            ELSE                                   ! 24h light or 24h night
-               !
-               IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day
-                  ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
-                  imask_night(ji,jj) = 0
-                  !
-               ELSE                                         ! No day
-                  zqsrout(ji,jj) = 0.0_wp
-                  imask_night(ji,jj) = 1
-               ENDIF
-            ENDIF
-         END DO  
-      END DO  
-      !
-      IF( PRESENT(l_mask) .AND. l_mask ) THEN
-         zqsrout(:,:) = float(imask_night(:,:))
-      ENDIF
-      !
-   END FUNCTION sbc_dcy
+      ENDIF !IF( nday_qsr /= nday )
+      !
+   END SUBROUTINE sbc_dcy_param
+
+
+   FUNCTION fintegral( pt1, pt2, paaa, pbbb, pccc )
+      REAL(wp), INTENT(in) :: pt1, pt2, paaa, pbbb, pccc
+      REAL(wp) :: fintegral
+      fintegral =   paaa * pt2 + 1._wp/(2._wp*rpi) * pbbb * SIN(pccc + 2._wp*rpi*pt2)   &
+         &        - paaa * pt1 - 1._wp/(2._wp*rpi) * pbbb * SIN(pccc + 2._wp*rpi*pt1)
+   END FUNCTION fintegral
 
    !!======================================================================

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

@@ -38 +38 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -91 +91 @@
       IF( kt == nit000 ) THEN                ! First call kt=nit000  
          ! set file information
-         REWIND( numnam_ref )              ! Namelist namsbc_flx in reference namelist : Files for fluxes
          READ  ( numnam_ref, namsbc_flx, IOSTAT = ios, ERR = 901)
 901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_flx in reference namelist' )
 
-         REWIND( numnam_cfg )              ! Namelist namsbc_flx in configuration namelist : Files for fluxes
          READ  ( numnam_cfg, namsbc_flx, IOSTAT = ios, ERR = 902 )
 902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist' )
@@ -131 +129 @@
          ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)
          ENDIF
-         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
-            DO ji = 1, jpi
-               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
-               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
-               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
-               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
-            END DO
-         END DO
+         DO_2D_11_11
+            utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
+            vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
+            qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
+            emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
+         END_2D
          !                                                        ! add to qns the heat due to e-p
          qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST
@@ -147 +143 @@
          !                                                        ! module of wind stress and wind speed at T-point
          zcoef = 1. / ( zrhoa * zcdrag )
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vect. opt.
-               ztx = utau(ji-1,jj  ) + utau(ji,jj) 
-               zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
-               zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
-               taum(ji,jj) = zmod
-               wndm(ji,jj) = SQRT( zmod * zcoef )
-            END DO
-         END DO
+         DO_2D_00_00
+            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
+            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
+            zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
+            taum(ji,jj) = zmod
+            wndm(ji,jj) = SQRT( zmod * zcoef )
+         END_2D
          taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1)
          CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1. )

NEMO/trunk/src/OCE/SBC/sbcfwb.F90

@@ -17 +17 @@
    USE dom_oce        ! ocean space and time domain
    USE sbc_oce        ! surface ocean boundary condition
+   USE isf_oce , ONLY : fwfisf_cav, fwfisf_par                    ! ice shelf melting contribution
    USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass
    USE phycst         ! physical constants
    USE sbcrnf         ! ocean runoffs
-   USE sbcisf         ! ice shelf melting contribution
    USE sbcssr         ! Sea-Surface damping terms
    !
@@ -39 +39 @@
    REAL(wp) ::   area      ! global mean ocean surface (interior domain)
 
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -48 +46 @@
 CONTAINS
 
-   SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc )
+   SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc, Kmm )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_fwb  ***
@@ -65 +63 @@
       INTEGER, INTENT( in ) ::   kn_fsbc  ! 
       INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index
+      INTEGER, INTENT( in ) ::   Kmm      ! ocean time level index
       !
       INTEGER  ::   inum, ikty, iyear     ! local integers
@@ -104 +103 @@
          !
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) )
+            y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) ) )
             CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 )
             z_fwfprv(1) = z_fwfprv(1) / area
@@ -131 +130 @@
             a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow
                                                       ! sum over the global domain
-            a_fwb   = glob_sum( 'sbcfwb', e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) )
+            a_fwb   = glob_sum( 'sbcfwb', e1e2t(:,:) * ( ssh(:,:,Kmm) + snwice_mass(:,:) * r1_rau0 ) )
             a_fwb   = a_fwb * 1.e+3 / ( area * rday * 365. )     ! convert in Kg/m3/s = mm/s
 !!gm        !                                                      !!bug 365d year 
@@ -159 +158 @@
             ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:)
             !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges) 
-            z_fwf     = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
+            z_fwf     = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) ) ) / area
             !            
             IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation

NEMO/trunk/src/OCE/SBC/sbcice_cice.F90

@@ -88 +88 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE ::   png     ! local array used in sbc_cice_ice
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -132 +134 @@
          IF      ( ksbc == jp_flx ) THEN
             CALL cice_sbc_force(kt)
-         ELSE IF ( ksbc == jp_purecpl ) THEN
+         ELSE IF( ksbc == jp_purecpl ) THEN
             CALL sbc_cpl_ice_flx( fr_i )
          ENDIF
@@ -140 +142 @@
          CALL cice_sbc_out ( kt, ksbc )
 
-         IF ( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1)
+         IF( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1)
 
       ENDIF                                          ! End sea-ice time step only
@@ -147 +149 @@
 
 
-   SUBROUTINE cice_sbc_init( ksbc )
+   SUBROUTINE cice_sbc_init( ksbc, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_init  ***
@@ -154 +156 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type
+      INTEGER, INTENT( in  ) ::   Kbb, Kmm            ! time level indices
       REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2
       REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar
@@ -168 +171 @@
       ! there is no restart file.
       ! Values from a CICE restart file would overwrite this
-      IF ( .NOT. ln_rstart ) THEN    
-         CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 
+      IF( .NOT. ln_rstart ) THEN    
+         CALL nemo2cice( ts(:,:,1,jp_tem,Kmm) , sst , 'T' , 1.) 
       ENDIF  
 #endif
@@ -177 +180 @@
 
 ! Do some CICE consistency checks
-      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
-         IF ( calc_strair .OR. calc_Tsfc ) THEN
+      IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
+         IF( calc_strair .OR. calc_Tsfc ) THEN
             CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' )
          ENDIF
-      ELSEIF (ksbc == jp_blk) THEN
-         IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN
+      ELSEIF(ksbc == jp_blk) THEN
+         IF( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN
             CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' )
          ENDIF
@@ -194 +197 @@
 ! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart
       IF( .NOT. ln_rstart ) THEN
-         tsn(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),Tocnfrz)
-         tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)
+         ts(:,:,:,jp_tem,Kmm) = MAX (ts(:,:,:,jp_tem,Kmm),Tocnfrz)
+         ts(:,:,:,jp_tem,Kbb) = ts(:,:,:,jp_tem,Kmm)
       ENDIF
 
@@ -202 +205 @@
 
       CALL cice2nemo(aice,fr_i, 'T', 1. )
-      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
+      IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -210 +213 @@
 ! T point to U point
 ! T point to V point
-      DO jj=1,jpjm1
-         DO ji=1,jpim1
-            fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1)
-            fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO_2D_10_10
+         fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1)
+         fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1)
+      END_2D
 
       CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1.,  fr_iv , 'V', 1. )
@@ -227 +228 @@
       IF( .NOT.ln_rstart ) THEN
          IF( ln_ice_embd ) THEN            ! embedded sea-ice: deplete the initial ssh below sea-ice area
-            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
-            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
+            ssh(:,:,Kmm) = ssh(:,:,Kmm) - snwice_mass(:,:) * r1_rau0
+            ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rau0
 
 !!gm This should be put elsewhere....   (same remark for limsbc)
@@ -235 +236 @@
                !
                DO jk = 1,jpkm1                     ! adjust initial vertical scale factors
-                  e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
-                  e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+                  e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+                  e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
                ENDDO
-               e3t_a(:,:,:) = e3t_b(:,:,:)
+               e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb)
                ! Reconstruction of all vertical scale factors at now and before time-steps
                ! =============================================================================
                ! Horizontal scale factor interpolations
                ! --------------------------------------
-               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
-               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
-               CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
-               CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
-               CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+               CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' )
+               CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )
+               CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' )
+               CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' )
+               CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' )
                ! Vertical scale factor interpolations
                ! ------------------------------------
-               CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
-               CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
-               CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
-               CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
-               CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+               CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  )
+               CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' )
+               CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' )
+               CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' )
+               CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' )
                ! t- and w- points depth
                ! ----------------------
-               gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
-               gdepw_n(:,:,1) = 0.0_wp
-               gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+               gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm)
+               gdepw(:,:,1,Kmm) = 0.0_wp
+               gde3w(:,:,1)     = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)
                DO jk = 2, jpk
-                  gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk)
-                  gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)
-                  gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:)
+                  gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk,Kmm)
+                  gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm)
+                  gde3w(:,:,jk)     = gdept(:,:,jk  ,Kmm) - sshn   (:,:)
                END DO
             ENDIF
@@ -297 +298 @@
 ! forced and coupled case 
 
-      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
+      IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
 
          ztmpn(:,:,:)=0.0
@@ -303 +304 @@
 ! x comp of wind stress (CI_1)
 ! U point to F point
-         DO jj=1,jpjm1
-            DO ji=1,jpi
-               ztmp(ji,jj) = 0.5 * (  fr_iu(ji,jj) * utau(ji,jj)      &
-                                    + fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1)
-            ENDDO
-         ENDDO
+         DO_2D_10_11
+            ztmp(ji,jj) = 0.5 * (  fr_iu(ji,jj) * utau(ji,jj)      &
+                                 + fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1)
+         END_2D
          CALL nemo2cice(ztmp,strax,'F', -1. )
 
 ! y comp of wind stress (CI_2)
 ! V point to F point
-         DO jj=1,jpj
-            DO ji=1,jpim1
-               ztmp(ji,jj) = 0.5 * (  fr_iv(ji,jj) * vtau(ji,jj)      &
-                                    + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1)
-            ENDDO
-         ENDDO
+         DO_2D_11_10
+            ztmp(ji,jj) = 0.5 * (  fr_iv(ji,jj) * vtau(ji,jj)      &
+                                 + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1)
+         END_2D
          CALL nemo2cice(ztmp,stray,'F', -1. )
 
 ! Surface downward latent heat flux (CI_5)
-         IF (ksbc == jp_flx) THEN
+         IF(ksbc == jp_flx) THEN
             DO jl=1,ncat
                ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl)
@@ -330 +327 @@
             qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * rLsub
 ! End of temporary code
-            DO jj=1,jpj
-               DO ji=1,jpi
-                  IF (fr_i(ji,jj).eq.0.0) THEN
-                     DO jl=1,ncat
-                        ztmpn(ji,jj,jl)=0.0
-                     ENDDO
-                     ! This will then be conserved in CICE
-                     ztmpn(ji,jj,1)=qla_ice(ji,jj,1)
-                  ELSE
-                     DO jl=1,ncat
-                        ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj)
-                     ENDDO
-                  ENDIF
-               ENDDO
-            ENDDO
+            DO_2D_11_11
+               IF(fr_i(ji,jj).eq.0.0) THEN
+                  DO jl=1,ncat
+                     ztmpn(ji,jj,jl)=0.0
+                  ENDDO
+                  ! This will then be conserved in CICE
+                  ztmpn(ji,jj,1)=qla_ice(ji,jj,1)
+               ELSE
+                  DO jl=1,ncat
+                     ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj)
+                  ENDDO
+               ENDIF
+            END_2D
          ENDIF
          DO jl=1,ncat
@@ -351 +346 @@
 ! GBM conductive flux through ice (CI_6)
 !  Convert to GBM
-            IF (ksbc == jp_flx) THEN
+            IF(ksbc == jp_flx) THEN
                ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl)
             ELSE
@@ -360 +355 @@
 ! GBM surface heat flux (CI_7)
 !  Convert to GBM
-            IF (ksbc == jp_flx) THEN
+            IF(ksbc == jp_flx) THEN
                ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 
             ELSE
@@ -368 +363 @@
          ENDDO
 
-      ELSE IF (ksbc == jp_blk) THEN
+      ELSE IF(ksbc == jp_blk) THEN
 
 ! Pass bulk forcing fields to CICE (which will calculate heat fluxes etc itself)
@@ -434 +429 @@
 ! x comp and y comp of surface ocean current
 ! U point to F point
-      DO jj=1,jpjm1
-         DO ji=1,jpi
-            ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO_2D_10_11
+         ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1)
+      END_2D
       CALL nemo2cice(ztmp,uocn,'F', -1. )
 
 ! V point to F point
-      DO jj=1,jpj
-         DO ji=1,jpim1
-            ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO_2D_11_10
+         ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1)
+      END_2D
       CALL nemo2cice(ztmp,vocn,'F', -1. )
 
@@ -468 +459 @@
 ! x comp and y comp of sea surface slope (on F points)
 ! T point to F point
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  )) * r1_e1u(ji,jj  )    &
-               &               + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1)  ) * fmask(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_10_10
+         ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  )) * r1_e1u(ji,jj  )    &
+            &               + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1)  ) * fmask(ji,jj,1)
+      END_2D
       CALL nemo2cice( ztmp,ss_tltx,'F', -1. )
 
 ! T point to F point
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj)) * r1_e2v(ji  ,jj)    &
-               &               + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj)  ) *  fmask(ji,jj,1)
-         END DO
-      END DO
+      DO_2D_10_10
+         ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj)) * r1_e2v(ji  ,jj)    &
+            &               + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj)  ) *  fmask(ji,jj,1)
+      END_2D
       CALL nemo2cice(ztmp,ss_tlty,'F', -1. )
       !
@@ -508 +495 @@
       ss_iou(:,:)=0.0
 ! F point to U point
-      DO jj=2,jpjm1
-         DO ji=2,jpim1
-            ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO_2D_00_00
+         ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1)
+      END_2D
       CALL lbc_lnk( 'sbcice_cice', ss_iou , 'U', -1. )
 
@@ -520 +505 @@
 ! F point to V point
 
-      DO jj=1,jpjm1
-         DO ji=2,jpim1
-            ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO_2D_10_00
+         ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1)
+      END_2D
       CALL lbc_lnk( 'sbcice_cice', ss_iov , 'V', -1. )
 
@@ -546 +529 @@
 ! Freshwater fluxes 
 
-      IF (ksbc == jp_flx) THEN
+      IF(ksbc == jp_flx) THEN
 ! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip)
 ! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below
@@ -552 +535 @@
 ! Better to use evap and tprecip? (but for now don't read in evap in this case)
          emp(:,:)  = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))
-      ELSE IF (ksbc == jp_blk) THEN
+      ELSE IF(ksbc == jp_blk) THEN
          emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)        
-      ELSE IF (ksbc == jp_purecpl) THEN
+      ELSE IF(ksbc == jp_purecpl) THEN
 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 
 ! This is currently as required with the coupling fields from the UM atmosphere
@@ -584 +567 @@
 ! Scale qsr and qns according to ice fraction (bulk formulae only)
 
-      IF (ksbc == jp_blk) THEN
+      IF(ksbc == jp_blk) THEN
          qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:))
          qns(:,:)=qns(:,:)*(1.0-fr_i(:,:))
       ENDIF
 ! Take into account snow melting except for fully coupled when already in qns_tot
-      IF (ksbc == jp_purecpl) THEN
+      IF(ksbc == jp_purecpl) THEN
          qsr(:,:)= qsr_tot(:,:)
          qns(:,:)= qns_tot(:,:)
@@ -606 +589 @@
       CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1. )
 
-      DO jj=1,jpj
-         DO ji=1,jpi
-            nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0)
-         ENDDO
-      ENDDO
+      DO_2D_11_11
+         nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0)
+      END_2D
 
 #if defined key_cice4
@@ -624 +605 @@
 
       CALL cice2nemo(aice,fr_i,'T', 1. )
-      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
+      IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -632 +613 @@
 ! T point to U point
 ! T point to V point
-      DO jj=1,jpjm1
-         DO ji=1,jpim1
-            fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1)
-            fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO_2D_10_10
+         fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1)
+         fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1)
+      END_2D
 
       CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1., fr_iv , 'V', 1. )
@@ -762 +741 @@
          sn_bot5 = FLD_N( 'botmeltn5_1m' ,    -1.    ,  'botmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
 
-         REWIND( numnam_ref )              ! Namelist namsbc_cice in reference namelist : 
          READ  ( numnam_ref, namsbc_cice, IOSTAT = ios, ERR = 901)
 901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cice in reference namelist' )
 
-         REWIND( numnam_cfg )              ! Namelist namsbc_cice in configuration namelist : Parameters of the run
          READ  ( numnam_cfg, namsbc_cice, IOSTAT = ios, ERR = 902 )
 902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_cice in configuration namelist' )
@@ -879 +856 @@
 !     B. Gather pn into global array (png)
 
-      IF ( jpnij > 1) THEN
+      IF( jpnij > 1) THEN
          CALL mppsync
          CALL mppgather (pn,0,png) 
@@ -892 +869 @@
 ! (may be OK but not 100% sure)
 
-      IF (nproc==0) THEN     
+      IF(nproc==0) THEN     
 !        pcg(:,:)=0.0
          DO jn=1,jpnij
@@ -996 +973 @@
 
       pn(:,:)=0.0
-      DO jj=1,jpjm1
-         DO ji=1,jpim1
-            pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1)
-         ENDDO
-      ENDDO
+      DO_2D_10_10
+         pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1)
+      END_2D
 
 #else
@@ -1015 +990 @@
 ! the lbclnk call on pn will replace these with sensible values
 
-      IF (nproc==0) THEN
+      IF(nproc==0) THEN
          png(:,:,:)=0.0
          DO jn=1,jpnij
@@ -1028 +1003 @@
 !     C. Scatter png into NEMO field (pn) for each processor
 
-      IF ( jpnij > 1) THEN
+      IF( jpnij > 1) THEN
          CALL mppsync
          CALL mppscatter (png,0,pn) 
@@ -1056 +1031 @@
    END SUBROUTINE sbc_ice_cice
 
-   SUBROUTINE cice_sbc_init (ksbc)    ! Dummy routine
+   SUBROUTINE cice_sbc_init (ksbc, Kbb, Kmm)    ! Dummy routine
       IMPLICIT NONE
       INTEGER, INTENT( in ) :: ksbc
+      INTEGER, INTENT( in ) :: Kbb, Kmm
       WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?', ksbc
    END SUBROUTINE cice_sbc_init

NEMO/trunk/src/OCE/SBC/sbcice_if.F90

@@ -35 +35 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ice   ! structure of input ice-cover (file informations, fields read)
    
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -42 +44 @@
 CONTAINS
 
-   SUBROUTINE sbc_ice_if( kt )
+   SUBROUTINE sbc_ice_if( kt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE sbc_ice_if  ***
@@ -59 +61 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       !
       INTEGER  ::   ji, jj     ! dummy loop indices
@@ -74 +77 @@
          !                                      ! ====================== !
          ! set file information
-         REWIND( numnam_ref )              ! Namelist namsbc_iif in reference namelist : Ice if file
          READ  ( numnam_ref, namsbc_iif, IOSTAT = ios, ERR = 901)
 901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_iif in reference namelist' )
 
-         REWIND( numnam_cfg )              ! Namelist Namelist namsbc_iif in configuration namelist : Ice if file
          READ  ( numnam_cfg, namsbc_iif, IOSTAT = ios, ERR = 902 )
 902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_iif in configuration namelist' )
@@ -108 +109 @@
 
          ! Flux and ice fraction computation
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !
-               zt_fzp  = fr_i(ji,jj)                        ! freezing point temperature
-               zfr_obs = sf_ice(1)%fnow(ji,jj,1)            ! observed ice cover
-               !                                            ! ocean ice fraction (0/1) from the freezing point temperature
-               IF( sst_m(ji,jj) <= zt_fzp ) THEN   ;   fr_i(ji,jj) = 1.e0
-               ELSE                                ;   fr_i(ji,jj) = 0.e0
-               ENDIF
+         DO_2D_11_11
+            !
+            zt_fzp  = fr_i(ji,jj)                        ! freezing point temperature
+            zfr_obs = sf_ice(1)%fnow(ji,jj,1)            ! observed ice cover
+            !                                            ! ocean ice fraction (0/1) from the freezing point temperature
+            IF( sst_m(ji,jj) <= zt_fzp ) THEN   ;   fr_i(ji,jj) = 1.e0
+            ELSE                                ;   fr_i(ji,jj) = 0.e0
+            ENDIF
 
-               tsn(ji,jj,1,jp_tem) = MAX( tsn(ji,jj,1,jp_tem), zt_fzp )     ! avoid over-freezing point temperature
+            ts(ji,jj,1,jp_tem,Kmm) = MAX( ts(ji,jj,1,jp_tem,Kmm), zt_fzp )     ! avoid over-freezing point temperature
 
-               qsr(ji,jj) = ( 1. - zfr_obs ) * qsr(ji,jj)   ! solar heat flux : zero below observed ice cover
+            qsr(ji,jj) = ( 1. - zfr_obs ) * qsr(ji,jj)   ! solar heat flux : zero below observed ice cover
 
-               !                                            ! non solar heat flux : add a damping term 
-               !      # ztrp*(t-(tgel-1.))  if observed ice and no opa ice   (zfr_obs=1 fr_i=0)
-               !      # ztrp*min(0,t-tgel)  if observed ice and opa ice      (zfr_obs=1 fr_i=1)
-               zqri = ztrp * ( tsb(ji,jj,1,jp_tem) - ( zt_fzp - 1.) )
-               zqrj = ztrp * MIN( 0., tsb(ji,jj,1,jp_tem) - zt_fzp )
-               zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri    &
-                 &                 +      fr_i(ji,jj)   * zqrj ) ) * tmask(ji,jj,1)
+            !                                            ! non solar heat flux : add a damping term 
+            !      # ztrp*(t-(tgel-1.))  if observed ice and no opa ice   (zfr_obs=1 fr_i=0)
+            !      # ztrp*min(0,t-tgel)  if observed ice and opa ice      (zfr_obs=1 fr_i=1)
+            zqri = ztrp * ( ts(ji,jj,1,jp_tem,Kbb) - ( zt_fzp - 1.) )
+            zqrj = ztrp * MIN( 0., ts(ji,jj,1,jp_tem,Kbb) - zt_fzp )
+            zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri    &
+              &                 +      fr_i(ji,jj)   * zqrj ) ) * tmask(ji,jj,1)
 
-               !                                            ! non-solar heat flux 
-               !      # qns unchanged              if no climatological ice              (zfr_obs=0)
-               !      # qns = zqrp                 if climatological ice and no opa ice  (zfr_obs=1, fr_i=0)
-               !      # qns = zqrp -2(-4) watt/m2  if climatological ice and opa ice     (zfr_obs=1, fr_i=1)
-               !                                   (-2=arctic, -4=antarctic)   
-               zqi = -3. + SIGN( 1._wp, ff_f(ji,jj) )
-               qns(ji,jj) = ( ( 1.- zfr_obs ) * qns(ji,jj)                             &
-                  &          +      zfr_obs   * fr_i(ji,jj) * zqi ) * tmask(ji,jj,1)   &
-                  &       + zqrp
-            END DO
-         END DO
+            !                                            ! non-solar heat flux 
+            !      # qns unchanged              if no climatological ice              (zfr_obs=0)
+            !      # qns = zqrp                 if climatological ice and no opa ice  (zfr_obs=1, fr_i=0)
+            !      # qns = zqrp -2(-4) watt/m2  if climatological ice and opa ice     (zfr_obs=1, fr_i=1)
+            !                                   (-2=arctic, -4=antarctic)   
+            zqi = -3. + SIGN( 1._wp, ff_f(ji,jj) )
+            qns(ji,jj) = ( ( 1.- zfr_obs ) * qns(ji,jj)                             &
+               &          +      zfr_obs   * fr_i(ji,jj) * zqi ) * tmask(ji,jj,1)   &
+               &       + zqrp
+         END_2D
          !
       ENDIF

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

@@ -15 +15 @@
    !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting
    !!            4.0  ! 2016-06  (L. Brodeau) new general bulk formulation
+   !!            4.0  ! 2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE)
    !!----------------------------------------------------------------------
 
@@ -24 +25 @@
    USE oce            ! ocean dynamics and tracers
    USE dom_oce        ! ocean space and time domain
+   USE closea         ! closed seas
    USE phycst         ! physical constants
    USE sbc_oce        ! Surface boundary condition: ocean fields
@@ -32 +34 @@
    USE sbcflx         ! surface boundary condition: flux formulation
    USE sbcblk         ! surface boundary condition: bulk formulation
+   USE sbcabl         ! atmospheric boundary layer
    USE sbcice_if      ! surface boundary condition: ice-if sea-ice model
 #if defined key_si3
@@ -37 +40 @@
 #endif
    USE sbcice_cice    ! surface boundary condition: CICE sea-ice model
-   USE sbcisf         ! surface boundary condition: ice-shelf
    USE sbccpl         ! surface boundary condition: coupled formulation
    USE cpl_oasis3     ! OASIS routines for coupling
+   USE sbcclo         ! surface boundary condition: closed sea correction
    USE sbcssr         ! surface boundary condition: sea surface restoring
    USE sbcrnf         ! surface boundary condition: runoffs
    USE sbcapr         ! surface boundary condition: atmo pressure 
-   USE sbcisf         ! surface boundary condition: ice shelf
    USE sbcfwb         ! surface boundary condition: freshwater budget
    USE icbstp         ! Icebergs
@@ -59 +61 @@
    USE timing         ! Timing
    USE wet_dry
-   USE diurnal_bulk, ONLY:   ln_diurnal_only   ! diurnal SST diagnostic
+   USE diu_bulk, ONLY:   ln_diurnal_only   ! diurnal SST diagnostic
 
    IMPLICIT NONE
@@ -76 +78 @@
 CONTAINS
 
-   SUBROUTINE sbc_init
+   SUBROUTINE sbc_init( Kbb, Kmm, Kaa )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE sbc_init ***
@@ -88 +90 @@
       !!              - nsbc: type of sbc
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Kmm, Kaa         ! ocean time level indices
       INTEGER ::   ios, icpt                         ! local integer
       LOGICAL ::   ll_purecpl, ll_opa, ll_not_nemo   ! local logical
       !!
       NAMELIST/namsbc/ nn_fsbc  ,                                                    &
-         &             ln_usr   , ln_flx   , ln_blk       ,                          &
+         &             ln_usr   , ln_flx   , ln_blk   , ln_abl,                      &
          &             ln_cpl   , ln_mixcpl, nn_components,                          &
          &             nn_ice   , ln_ice_embd,                                       &
          &             ln_traqsr, ln_dm2dc ,                                         &
-         &             ln_rnf   , nn_fwb   , ln_ssr   , ln_isf    , ln_apr_dyn ,     &
-         &             ln_wave  , ln_cdgw  , ln_sdw   , ln_tauwoc  , ln_stcor   ,     &
+         &             ln_rnf   , nn_fwb     , ln_ssr   , ln_apr_dyn,              &
+         &             ln_wave  , ln_cdgw  , ln_sdw   , ln_tauwoc  , ln_stcor  ,     &
          &             ln_tauw  , nn_lsm, nn_sdrift
       !!----------------------------------------------------------------------
@@ -108 +111 @@
       !
       !                       !**  read Surface Module namelist
-      REWIND( numnam_ref )          !* Namelist namsbc in reference namelist : Surface boundary
       READ  ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist' )
-      REWIND( numnam_cfg )          !* Namelist namsbc in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist' )
@@ -125 +126 @@
          IF( lk_cice )   nn_ice      = 3
       ENDIF
-#else
-      IF( lk_si3  )   nn_ice      = 2
-      IF( lk_cice )   nn_ice      = 3
+!!GS: TBD
+!#else
+!      IF( lk_si3  )   nn_ice      = 2
+!      IF( lk_cice )   nn_ice      = 3
 #endif
       !
@@ -137 +139 @@
          WRITE(numout,*) '         flux         formulation                   ln_flx        = ', ln_flx
          WRITE(numout,*) '         bulk         formulation                   ln_blk        = ', ln_blk
+         WRITE(numout,*) '         ABL          formulation                   ln_abl        = ', ln_abl
          WRITE(numout,*) '      Type of coupling (Ocean/Ice/Atmosphere) : '
          WRITE(numout,*) '         ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl
@@ -153 +156 @@
          WRITE(numout,*) '         Patm gradient added in ocean & ice Eqs.    ln_apr_dyn    = ', ln_apr_dyn
          WRITE(numout,*) '         runoff / runoff mouths                     ln_rnf        = ', ln_rnf
-         WRITE(numout,*) '         iceshelf formulation                       ln_isf        = ', ln_isf
          WRITE(numout,*) '         nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm
          WRITE(numout,*) '         surface wave                               ln_wave       = ', ln_wave
@@ -225 +227 @@
       CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model)  
       CASE( 2 )                        !- SI3  ice model
+         IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) )   &
+            &                   CALL ctl_stop( 'sbc_init : SI3 sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' )
       CASE( 3 )                        !- CICE ice model
-         IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl = T' )
-         IF( lk_agrif                    )   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 
+         IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) )   &
+            &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' )
+         IF( lk_agrif                                )   &
+            &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 
       CASE DEFAULT                     !- not supported
       END SELECT
+      IF( ln_diurnal .AND. .NOT. ln_blk  )   CALL ctl_stop( "sbc_init: diurnal flux processing only implemented for bulk forcing" )
       !
       !                       !**  allocate and set required variables
@@ -239 +246 @@
 #endif
       !
-      IF( .NOT.ln_isf ) THEN        !* No ice-shelf in the domain : allocate and set to zero
-         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
-         fwfisf  (:,:)   = 0._wp   ;   risf_tsc  (:,:,:) = 0._wp
-         fwfisf_b(:,:)   = 0._wp   ;   risf_tsc_b(:,:,:) = 0._wp
-      END IF
       !
       IF( sbc_ssr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_ssr arrays' )
@@ -262 +264 @@
 
       !                          ! Choice of the Surface Boudary Condition (set nsbc)
+      nday_qsr = -1   ! allow initialization at the 1st call !LB: now warm-layer of COARE* calls "sbc_dcy_param" of sbcdcy.F90!
       IF( ln_dm2dc ) THEN           !* daily mean to diurnal cycle
-         nday_qsr = -1   ! allow initialization at the 1st call
-         IF( .NOT.( ln_flx .OR. ln_blk ) .AND. nn_components /= jp_iam_opa )   &
-            &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires a flux or bulk formulation' )
+         !LB:nday_qsr = -1   ! allow initialization at the 1st call
+         IF( .NOT.( ln_flx .OR. ln_blk .OR. ln_abl ) .AND. nn_components /= jp_iam_opa )   &
+            &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires flux, bulk or abl formulation' )
       ENDIF
       !                             !* Choice of the Surface Boudary Condition
@@ -278 +281 @@
       IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation
       IF( ln_blk          ) THEN   ;   nsbc = jp_blk     ; icpt = icpt + 1   ;   ENDIF       ! bulk                 formulation
+      IF( ln_abl          ) THEN   ;   nsbc = jp_abl     ; icpt = icpt + 1   ;   ENDIF       ! ABL                  formulation
       IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation
       IF( ll_opa          ) THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module
@@ -289 +293 @@
          CASE( jp_flx     )   ;   WRITE(numout,*) '   ==>>>   flux formulation'
          CASE( jp_blk     )   ;   WRITE(numout,*) '   ==>>>   bulk formulation'
+         CASE( jp_abl     )   ;   WRITE(numout,*) '   ==>>>   ABL  formulation'
          CASE( jp_purecpl )   ;   WRITE(numout,*) '   ==>>>   pure coupled formulation'
 !!gm abusive use of jp_none ??   ===>>> need to be check and changed by adding a jp_sas parameter
@@ -335 +340 @@
       !                       !**  associated modules : initialization
       !
-                          CALL sbc_ssm_init            ! Sea-surface mean fields initialization
+                          CALL sbc_ssm_init ( Kbb, Kmm ) ! Sea-surface mean fields initialization
+      !
+      IF( l_sbc_clo   )   CALL sbc_clo_init              ! closed sea surface initialisation
       !
       IF( ln_blk      )   CALL sbc_blk_init            ! bulk formulae initialization
 
+      IF( ln_abl      )   CALL sbc_abl_init            ! Atmospheric Boundary Layer (ABL)
+
       IF( ln_ssr      )   CALL sbc_ssr_init            ! Sea-Surface Restoring initialization
       !
-      IF( ln_isf      )   CALL sbc_isf_init            ! Compute iceshelves
-      !
-                          CALL sbc_rnf_init            ! Runof initialization
-      !
-      IF( ln_apr_dyn )    CALL sbc_apr_init            ! Atmo Pressure Forcing initialization
+      !
+                          CALL sbc_rnf_init( Kmm )       ! Runof initialization
+      !
+      IF( ln_apr_dyn )    CALL sbc_apr_init              ! Atmo Pressure Forcing initialization
       !
 #if defined key_si3
@@ -351 +359 @@
                           IF( sbc_ice_alloc() /= 0 )   CALL ctl_stop('STOP', 'sbc_ice_alloc : unable to allocate arrays' )
       ELSEIF( nn_ice == 2 ) THEN
-                          CALL ice_init                ! ICE initialization
+                          CALL ice_init( Kbb, Kmm, Kaa )         ! ICE initialization
       ENDIF
 #endif
-      IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc )   ! CICE initialization
-      !
-      IF( ln_wave     )   CALL sbc_wave_init           ! surface wave initialisation
+      IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc, Kbb, Kmm )   ! CICE initialization
+      !
+      IF( ln_wave     )   CALL sbc_wave_init                     ! surface wave initialisation
       !
       IF( lwxios ) THEN
@@ -371 +379 @@
 
 
-   SUBROUTINE sbc( kt )
+   SUBROUTINE sbc( kt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE sbc  ***
@@ -388 +396 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       !
       LOGICAL ::   ll_sas, ll_opa   ! local logical
@@ -406 +415 @@
          emp_b (:,:) = emp (:,:)
          sfx_b (:,:) = sfx (:,:)
-         IF ( ln_rnf ) THEN
+         IF( ln_rnf ) THEN
             rnf_b    (:,:  ) = rnf    (:,:  )
             rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
          ENDIF
-         IF( ln_isf )  THEN
-            fwfisf_b  (:,:  ) = fwfisf  (:,:  )               
-            risf_tsc_b(:,:,:) = risf_tsc(:,:,:)              
-         ENDIF
         !
       ENDIF
@@ -423 +428 @@
       ll_opa = nn_components == jp_iam_opa
       !
-      IF( .NOT.ll_sas )   CALL sbc_ssm ( kt )            ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
-      IF( ln_wave     )   CALL sbc_wave( kt )            ! surface waves
+      IF( .NOT.ll_sas )   CALL sbc_ssm ( kt, Kbb, Kmm )  ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
+      IF( ln_wave     )   CALL sbc_wave( kt, Kmm )       ! surface waves
 
       !
@@ -431 +436 @@
       SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition
       !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx)
-      CASE( jp_usr   )     ;   CALL usrdef_sbc_oce( kt )                    ! user defined formulation 
-      CASE( jp_flx     )   ;   CALL sbc_flx       ( kt )                    ! flux formulation
+      CASE( jp_usr   )     ;   CALL usrdef_sbc_oce( kt, Kbb )                        ! user defined formulation 
+      CASE( jp_flx     )   ;   CALL sbc_flx       ( kt )                             ! flux formulation
       CASE( jp_blk     )
-         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA
+         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OPA-SAS coupling: SAS receiving fields from OPA
                                CALL sbc_blk       ( kt )                    ! bulk formulation for the ocean
                                !
-      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation
+      CASE( jp_abl     )
+         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OPA-SAS coupling: SAS receiving fields from OPA
+                               CALL sbc_abl       ( kt )                    ! ABL  formulation for the ocean
+                               !
+      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! pure coupled formulation
       CASE( jp_none    )
-         IF( ll_opa    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS
+         IF( ll_opa    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! OPA-SAS coupling: OPA receiving fields from SAS
       END SELECT
       !
-      IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing
-      !
-      IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )      ! Wind stress provided by waves 
+      IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! forced-coupled mixed formulation after forcing
+      !
+      IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )              ! Wind stress provided by waves 
       !
       !                                            !==  Misc. Options  ==!
       !
       SELECT CASE( nn_ice )                                       ! Update heat and freshwater fluxes over sea-ice areas
-      CASE(  1 )   ;         CALL sbc_ice_if   ( kt )             ! Ice-cover climatology ("Ice-if" model)
+      CASE(  1 )   ;         CALL sbc_ice_if   ( kt, Kbb, Kmm )   ! Ice-cover climatology ("Ice-if" model)
 #if defined key_si3
-      CASE(  2 )   ;         CALL ice_stp  ( kt, nsbc )           ! SI3 ice model
+      CASE(  2 )   ;         CALL ice_stp  ( kt, Kbb, Kmm, nsbc ) ! SI3 ice model
 #endif
       CASE(  3 )   ;         CALL sbc_ice_cice ( kt, nsbc )       ! CICE ice model
@@ -458 +467 @@
       IF( ln_icebergs    )   THEN
                                      CALL icb_stp( kt )           ! compute icebergs
-         ! icebergs may advect into haloes during the icb step and alter emp.
-         ! A lbc_lnk is necessary here to ensure restartability (#2113)
+         ! Icebergs do not melt over the haloes. 
+         ! So emp values over the haloes are no more consistent with the inner domain values. 
+         ! A lbc_lnk is therefore needed to ensure reproducibility and restartability.
+         ! see ticket #2113 for discussion about this lbc_lnk.
          IF( .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1. ) ! ensure restartability with icebergs
       ENDIF
 
-      IF( ln_isf         )   CALL sbc_isf( kt )                   ! compute iceshelves
-
       IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes
 
-      IF( ln_ssr         )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term
-
-      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
+      IF( ln_ssr         )   CALL sbc_ssr( kt )                        ! add SST/SSS damping term
+
+      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc, Kmm )  ! control the freshwater budget
 
       ! Special treatment of freshwater fluxes over closed seas in the model domain
       ! Should not be run if ln_diurnal_only
-      IF( l_sbc_clo .AND. (.NOT. ln_diurnal_only) )   CALL sbc_clo( kt )   
+      IF( l_sbc_clo      )   CALL sbc_clo( kt )   
 
 !!$!RBbug do not understand why see ticket 667
 !!$!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
 !!$      CALL lbc_lnk( 'sbcmod', emp, 'T', 1. )
-      IF ( ll_wd ) THEN     ! If near WAD point limit the flux for now
+      IF( ll_wd ) THEN     ! If near WAD point limit the flux for now
          zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999 
-         zwdht(:,:) = sshn(:,:) + ht_0(:,:) - rn_wdmin1   ! do this calc of water
+         zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1   ! do this calc of water
                                                      ! depth above wd limit once
          WHERE( zwdht(:,:) <= 0.0 )
@@ -510 +519 @@
             CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b, ldxios = lrxios )   ! before i-stress  (U-point)
             CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b, ldxios = lrxios )   ! before j-stress  (V-point)
-            CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b, ldxios = lrxios  )   ! before non solar heat flux (T-point)
+            CALL iom_get( numror, jpdom_autoglo,  'qns_b',  qns_b, ldxios = lrxios )   ! before non solar heat flux (T-point)
             ! The 3D heat content due to qsr forcing is treated in traqsr
             ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b, ldxios = lrxios  ) ! before     solar heat flux (T-point)
@@ -567 +576 @@
       CALL iom_put( "vtau", vtau )   ! j-wind stress
       !
-      IF(ln_ctl) THEN         ! print mean trends (used for debugging)
-         CALL prt_ctl(tab2d_1=fr_i              , clinfo1=' fr_i    - : ', mask1=tmask )
-         CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf - : ', mask1=tmask )
-         CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf - : ', mask1=tmask )
+      IF(sn_cfctl%l_prtctl) THEN     ! print mean trends (used for debugging)
+         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i     - : ', mask1=tmask )
+         CALL prt_ctl(tab2d_1=(emp-rnf)        , clinfo1=' emp-rnf  - : ', mask1=tmask )
+         CALL prt_ctl(tab2d_1=(sfx-rnf)        , clinfo1=' sfx-rnf  - : ', mask1=tmask )
          CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask )
          CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask )
          CALL prt_ctl(tab3d_1=tmask            , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk )
-         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' sst      - : ', mask1=tmask, kdim=1   )
-         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sss      - : ', mask1=tmask, kdim=1   )
-         CALL prt_ctl(tab2d_1=utau             , clinfo1=' utau     - : ', mask1=umask,                      &
-            &         tab2d_2=vtau             , clinfo2=' vtau     - : ', mask2=vmask )
+         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst      - : ', mask1=tmask, kdim=1   )
+         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss      - : ', mask1=tmask, kdim=1   )
+         CALL prt_ctl(tab2d_1=utau                , clinfo1=' utau     - : ', mask1=umask,                      &
+            &         tab2d_2=vtau                , clinfo2=' vtau     - : ', mask2=vmask )
       ENDIF
 

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

@@ -70 +70 @@
    TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)  
  
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -183 +185 @@
 
 
-   SUBROUTINE sbc_rnf_div( phdivn )
+   SUBROUTINE sbc_rnf_div( phdivn, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_rnf  ***
@@ -195 +197 @@
       !! ** Action  :   phdivn   decreased by the runoff inflow
       !!----------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   Kmm      ! ocean time level index
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
       !!
@@ -205 +208 @@
       IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==!
          IF( ln_linssh ) THEN    !* constant volume case : just apply the runoff input flow
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  DO jk = 1, nk_rnf(ji,jj)
-                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
-                  END DO
+            DO_2D_11_11
+               DO jk = 1, nk_rnf(ji,jj)
+                  phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
                END DO
-            END DO
+            END_2D
          ELSE                    !* variable volume case
-            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed
-               DO ji = 1, jpi
-                  h_rnf(ji,jj) = 0._wp
-                  DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
-                     h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)   ! to the bottom of the relevant grid box
-                  END DO
-                  !                          ! apply the runoff input flow
-                  DO jk = 1, nk_rnf(ji,jj)
-                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
-                  END DO
+            DO_2D_11_11
+               h_rnf(ji,jj) = 0._wp
+               DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
+                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm)   ! to the bottom of the relevant grid box
                END DO
-            END DO
+               !                          ! apply the runoff input flow
+               DO jk = 1, nk_rnf(ji,jj)
+                  phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
+               END DO
+            END_2D
          ENDIF
       ELSE                       !==   runoff put only at the surface   ==!
-         h_rnf (:,:)   = e3t_n (:,:,1)        ! update h_rnf to be depth of top box
-         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1)
+         h_rnf (:,:)   = e3t (:,:,1,Kmm)        ! update h_rnf to be depth of top box
+         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t(:,:,1,Kmm)
       ENDIF
       !
@@ -234 +233 @@
 
 
-   SUBROUTINE sbc_rnf_init
+   SUBROUTINE sbc_rnf_init( Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_rnf_init  ***
@@ -244 +243 @@
       !! ** Action  : - read parameters
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kmm           ! ocean time level index
       CHARACTER(len=32) ::   rn_dep_file   ! runoff file name
       INTEGER           ::   ji, jj, jk, jm    ! dummy loop indices
@@ -275 +275 @@
       !                                   ! ============
       !
-      REWIND( numnam_ref )
       READ  ( numnam_ref, namsbc_rnf, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_rnf in reference namelist' )
 
-      REWIND( numnam_cfg )
       READ  ( numnam_cfg, namsbc_rnf, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_rnf in configuration namelist' )
@@ -362 +360 @@
          !
          nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( h_rnf(ji,jj) > 0._wp ) THEN
-                  jk = 2
-                  DO WHILE ( jk < mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
-                  END DO
-                  nk_rnf(ji,jj) = jk
-               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1
-               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
-               ELSE
-                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
-                  WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
-               ENDIF
+         DO_2D_11_11
+            IF( h_rnf(ji,jj) > 0._wp ) THEN
+               jk = 2
+               DO WHILE ( jk < mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
+               END DO
+               nk_rnf(ji,jj) = jk
+            ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1
+            ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
+            ELSE
+               CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
+               WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
+            ENDIF
+         END_2D
+         DO_2D_11_11
+            h_rnf(ji,jj) = 0._wp
+            DO jk = 1, nk_rnf(ji,jj)
+               h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm)
             END DO
-         END DO
-         DO jj = 1, jpj                                ! set the associated depth
-            DO ji = 1, jpi
-               h_rnf(ji,jj) = 0._wp
-               DO jk = 1, nk_rnf(ji,jj)
-                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         END_2D
          !
       ELSE IF( ln_rnf_depth_ini ) THEN           ! runoffs applied at the surface
@@ -409 +403 @@
          WHERE( zrnfcl(:,:,1) > 0._wp )  h_rnf(:,:) = zacoef * zrnfcl(:,:,1)   ! compute depth for all runoffs
          !
-         DO jj = 1, jpj                     ! take in account min depth of ocean rn_hmin
-            DO ji = 1, jpi
-               IF( zrnfcl(ji,jj,1) > 0._wp ) THEN
-                  jk = mbkt(ji,jj)
-                  h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) )
-               ENDIF
+         DO_2D_11_11
+            IF( zrnfcl(ji,jj,1) > 0._wp ) THEN
+               jk = mbkt(ji,jj)
+               h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) )
+            ENDIF
+         END_2D
+         !
+         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed
+         DO_2D_11_11
+            IF( zrnfcl(ji,jj,1) > 0._wp ) THEN
+               jk = 2
+               DO WHILE ( jk < mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
+               END DO
+               nk_rnf(ji,jj) = jk
+            ELSE
+               nk_rnf(ji,jj) = 1
+            ENDIF
+         END_2D
+         !
+         DO_2D_11_11
+            h_rnf(ji,jj) = 0._wp
+            DO jk = 1, nk_rnf(ji,jj)
+               h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm)
             END DO
-         END DO
-         !
-         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( zrnfcl(ji,jj,1) > 0._wp ) THEN
-                  jk = 2
-                  DO WHILE ( jk < mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
-                  END DO
-                  nk_rnf(ji,jj) = jk
-               ELSE
-                  nk_rnf(ji,jj) = 1
-               ENDIF
-            END DO
-         END DO
-         !
-         DO jj = 1, jpj                                ! set the associated depth
-            DO ji = 1, jpi
-               h_rnf(ji,jj) = 0._wp
-               DO jk = 1, nk_rnf(ji,jj)
-                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         END_2D
          !
          IF( nn_rnf_depth_file == 1 ) THEN      !  save  output nb levels for runoff
@@ -449 +437 @@
       ELSE                                       ! runoffs applied at the surface
          nk_rnf(:,:) = 1
-         h_rnf (:,:) = e3t_n(:,:,1)
+         h_rnf (:,:) = e3t(:,:,1,Kmm)
       ENDIF
       !

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

@@ -39 +39 @@
 CONTAINS
 
-   SUBROUTINE sbc_ssm( kt )
+   SUBROUTINE sbc_ssm( kt, Kbb, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE sbc_oce  ***
@@ -53 +53 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       !
       INTEGER  ::   ji, jj               ! loop index
@@ -60 +61 @@
       !
       !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity)
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem)
-            zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal)
-         END DO
-      END DO
+      zts(:,:,jp_tem) = ts(:,:,1,jp_tem,Kmm)
+      zts(:,:,jp_sal) = ts(:,:,1,jp_sal,Kmm)
       !
       IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        !
          !                                                ! ---------------------------------------- !
-         ssu_m(:,:) = ub(:,:,1)
-         ssv_m(:,:) = vb(:,:,1)
+         ssu_m(:,:) = uu(:,:,1,Kbb)
+         ssv_m(:,:) = vv(:,:,1,Kbb)
          IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
-         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem)
+         ELSE                   ;   sst_m(:,:) = zts(:,:,jp_tem)
          ENDIF
          sss_m(:,:) = zts(:,:,jp_sal)
          !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
-         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
-         ELSE                    ;   ssh_m(:,:) = sshn(:,:)
-         ENDIF
-         !
-         e3t_m(:,:) = e3t_n(:,:,1)
+         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ssh_m(:,:) = ssh(:,:,Kmm)
+         ENDIF
+         !
+         e3t_m(:,:) = e3t(:,:,1,Kmm)
          !
          frq_m(:,:) = fraqsr_1lev(:,:)
@@ -92 +89 @@
             IF(lwp) WRITE(numout,*) '~~~~~~~   '
             zcoef = REAL( nn_fsbc - 1, wp )
-            ssu_m(:,:) = zcoef * ub(:,:,1)
-            ssv_m(:,:) = zcoef * vb(:,:,1)
+            ssu_m(:,:) = zcoef * uu(:,:,1,Kbb)
+            ssv_m(:,:) = zcoef * vv(:,:,1,Kbb)
             IF( l_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
             ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem)
@@ -99 +96 @@
             sss_m(:,:) = zcoef * zts(:,:,jp_sal)
             !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
-            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )
-            ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:)
-            ENDIF
-            !
-            e3t_m(:,:) = zcoef * e3t_n(:,:,1)
+            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )
+            ELSE                    ;   ssh_m(:,:) = zcoef *   ssh(:,:,Kmm)
+            ENDIF
+            !
+            e3t_m(:,:) = zcoef * e3t(:,:,1,Kmm)
             !
             frq_m(:,:) = zcoef * fraqsr_1lev(:,:)
@@ -120 +117 @@
          !                                                !        Cumulate at each time step        !
          !                                                ! ---------------------------------------- !
-         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1)
-         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1)
+         ssu_m(:,:) = ssu_m(:,:) + uu(:,:,1,Kbb)
+         ssv_m(:,:) = ssv_m(:,:) + vv(:,:,1,Kbb)
          IF( l_useCT )  THEN     ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
          ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem)
@@ -127 +124 @@
          sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal)
          !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
-         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
-         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:)
-         ENDIF
-         !
-         e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1)
+         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + ssh(:,:,Kmm)
+         ENDIF
+         !
+         e3t_m(:,:) = e3t_m(:,:) + e3t(:,:,1,Kmm)
          !
          frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:)
@@ -184 +181 @@
 
 
-   SUBROUTINE sbc_ssm_init
+   SUBROUTINE sbc_ssm_init( Kbb, Kmm )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_ssm_init  ***
@@ -192 +189 @@
       !! ** Action  : - read parameters
       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
       REAL(wp) ::   zcoef, zf_sbc   ! local scalar
       !!----------------------------------------------------------------------
@@ -242 +240 @@
          !
          IF(lwp) WRITE(numout,*) '   default initialisation of ss._m arrays'
-         ssu_m(:,:) = ub(:,:,1)
-         ssv_m(:,:) = vb(:,:,1)
-         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
-         ELSE                   ;   sst_m(:,:) = tsn(:,:,1,jp_tem)
-         ENDIF
-         sss_m(:,:) = tsn  (:,:,1,jp_sal)
-         ssh_m(:,:) = sshn (:,:)
-         e3t_m(:,:) = e3t_n(:,:,1)
+         ssu_m(:,:) = uu(:,:,1,Kbb)
+         ssv_m(:,:) = vv(:,:,1,Kbb)
+         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) )
+         ELSE                   ;   sst_m(:,:) = ts(:,:,1,jp_tem,Kmm)
+         ENDIF
+         sss_m(:,:) = ts  (:,:,1,jp_sal,Kmm)
+         ssh_m(:,:) = ssh(:,:,Kmm)
+         e3t_m(:,:) = e3t (:,:,1,Kmm)
          frq_m(:,:) = 1._wp
          !

NEMO/trunk/src/OCE/SBC/sbcssr.F90

@@ -49 +49 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sss   ! structure of input SSS (file informations, fields read)
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -93 +95 @@
             !
             IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
-                     qns(ji,jj) = qns(ji,jj) + zqrp
-                     qrp(ji,jj) = zqrp
-                  END DO
-               END DO
+               DO_2D_11_11
+                  zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
+                  qns(ji,jj) = qns(ji,jj) + zqrp
+                  qrp(ji,jj) = zqrp
+               END_2D
             ENDIF
             !
@@ -105 +105 @@
               ! use fraction of ice ( fr_i ) to adjust relaxation under ice if nn_sssr_ice .ne. 1
               ! n.b. coefice is initialised and fixed to 1._wp if nn_sssr_ice = 1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     SELECT CASE ( nn_sssr_ice )
-                       CASE ( 0 )    ;  coefice(ji,jj) = 1._wp - fr_i(ji,jj)              ! no/reduced damping under ice
-                       CASE  DEFAULT ;  coefice(ji,jj) = 1._wp + ( nn_sssr_ice - 1 ) * fr_i(ji,jj) ! reinforced damping (x nn_sssr_ice) under ice )
-                     END SELECT
-                  END DO
-               END DO
+               DO_2D_11_11
+                  SELECT CASE ( nn_sssr_ice )
+                    CASE ( 0 )    ;  coefice(ji,jj) = 1._wp - fr_i(ji,jj)              ! no/reduced damping under ice
+                    CASE  DEFAULT ;  coefice(ji,jj) = 1._wp + ( nn_sssr_ice - 1 ) * fr_i(ji,jj) ! reinforced damping (x nn_sssr_ice) under ice )
+                  END SELECT
+               END_2D
             ENDIF
             !
             IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx))
                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
-                        &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice
-                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
-                     sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux
-                     erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only)
-                  END DO
-               END DO
+               DO_2D_11_11
+                  zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
+                     &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice
+                     &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
+                  sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux
+                  erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only)
+               END_2D
                !
             ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns)
                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
                zerp_bnd = rn_sssr_bnd / rday                          !       -              -    
-               DO jj = 1, jpj
-                  DO ji = 1, jpi                            
-                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
-                        &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice
-                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
-                        &        / MAX(  sss_m(ji,jj), 1.e-20   ) * tmask(ji,jj,1)
-                     IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
-                     emp(ji,jj) = emp (ji,jj) + zerp
-                     qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj)
-                     erp(ji,jj) = zerp
-                  END DO
-               END DO
+               DO_2D_11_11
+                  zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
+                     &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice
+                     &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
+                     &        / MAX(  sss_m(ji,jj), 1.e-20   ) * tmask(ji,jj,1)
+                  IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
+                  emp(ji,jj) = emp (ji,jj) + zerp
+                  qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj)
+                  erp(ji,jj) = zerp
+               END_2D
             ENDIF
             !
@@ -180 +174 @@
       ENDIF
       ! 
-      REWIND( numnam_ref )              ! Namelist namsbc_ssr in reference namelist : 
       READ  ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist' )
 
-      REWIND( numnam_cfg )              ! Namelist namsbc_ssr in configuration namelist :
       READ  ( numnam_cfg, namsbc_ssr, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist' )

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

@@ -72 +72 @@
 
    !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -80 +80 @@
 CONTAINS
 
-   SUBROUTINE sbc_stokes( )
+   SUBROUTINE sbc_stokes( Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE sbc_stokes  ***
@@ -92 +92 @@
       !! ** action  
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: Kmm ! ocean time level index
       INTEGER  ::   jj, ji, jk   ! dummy loop argument
       INTEGER  ::   ik           ! local integer 
@@ -111 +112 @@
       IF( ll_st_bv_li ) THEN   ! (Eq. (19) in Breivik et al. (2014) )
          zfac = 2.0_wp * rpi / 16.0_wp
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! Stokes drift velocity estimated from Hs and Tmean
-               ztransp = zfac * hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp )
-               ! Stokes surface speed
-               tsd2d(ji,jj) = SQRT( ut0sd(ji,jj)*ut0sd(ji,jj) + vt0sd(ji,jj)*vt0sd(ji,jj))
-               ! Wavenumber scale
-               zk_t(ji,jj) = ABS( tsd2d(ji,jj) ) / MAX( ABS( 5.97_wp*ztransp ), 0.0000001_wp )
-            END DO
-         END DO
-         DO jj = 1, jpjm1              ! exp. wave number & Stokes drift velocity at u- & v-points
-            DO ji = 1, jpim1
-               zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
-               zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
-               !
-               zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) )
-               zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) )
-            END DO
-         END DO
+         DO_2D_11_11
+            ! Stokes drift velocity estimated from Hs and Tmean
+            ztransp = zfac * hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp )
+            ! Stokes surface speed
+            tsd2d(ji,jj) = SQRT( ut0sd(ji,jj)*ut0sd(ji,jj) + vt0sd(ji,jj)*vt0sd(ji,jj))
+            ! Wavenumber scale
+            zk_t(ji,jj) = ABS( tsd2d(ji,jj) ) / MAX( ABS( 5.97_wp*ztransp ), 0.0000001_wp )
+         END_2D
+         DO_2D_10_10
+            zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
+            zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
+            !
+            zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) )
+            zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) )
+         END_2D
       ELSE IF( ll_st_peakfr ) THEN    ! peak wave number calculated from the peak frequency received by the wave model
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zk_t(ji,jj) = ( 2.0_wp * rpi * wfreq(ji,jj) ) * ( 2.0_wp * rpi * wfreq(ji,jj) ) / grav
-            END DO
-         END DO
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
-               zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
-               !
-               zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) )
-               zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) )
-            END DO
-         END DO
+         DO_2D_11_11
+            zk_t(ji,jj) = ( 2.0_wp * rpi * wfreq(ji,jj) ) * ( 2.0_wp * rpi * wfreq(ji,jj) ) / grav
+         END_2D
+         DO_2D_10_10
+            zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
+            zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
+            !
+            zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) )
+            zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) )
+         END_2D
       ENDIF
       !
       !                       !==  horizontal Stokes Drift 3D velocity  ==!
       IF( ll_st_bv2014 ) THEN
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  zdep_u = 0.5_wp * ( gdept_n(ji,jj,jk) + gdept_n(ji+1,jj,jk) )
-                  zdep_v = 0.5_wp * ( gdept_n(ji,jj,jk) + gdept_n(ji,jj+1,jk) )
-                  !                          
-                  zkh_u = zk_u(ji,jj) * zdep_u     ! k * depth
-                  zkh_v = zk_v(ji,jj) * zdep_v
-                  !                                ! Depth attenuation
-                  zda_u = EXP( -2.0_wp*zkh_u ) / ( 1.0_wp + 8.0_wp*zkh_u )
-                  zda_v = EXP( -2.0_wp*zkh_v ) / ( 1.0_wp + 8.0_wp*zkh_v )
-                  !
-                  usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)
-                  vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zdep_u = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji+1,jj,jk,Kmm) )
+            zdep_v = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji,jj+1,jk,Kmm) )
+            !                          
+            zkh_u = zk_u(ji,jj) * zdep_u     ! k * depth
+            zkh_v = zk_v(ji,jj) * zdep_v
+            !                                ! Depth attenuation
+            zda_u = EXP( -2.0_wp*zkh_u ) / ( 1.0_wp + 8.0_wp*zkh_u )
+            zda_v = EXP( -2.0_wp*zkh_v ) / ( 1.0_wp + 8.0_wp*zkh_v )
+            !
+            usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)
+            vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)
+         END_3D
       ELSE IF( ll_st_li2017 .OR. ll_st_peakfr ) THEN
          ALLOCATE( zstokes_psi_u_top(jpi,jpj), zstokes_psi_v_top(jpi,jpj) )
-         DO jj = 1, jpjm1              ! exp. wave number & Stokes drift velocity at u- & v-points
-            DO ji = 1, jpim1
-               zstokes_psi_u_top(ji,jj) = 0._wp
-               zstokes_psi_v_top(ji,jj) = 0._wp
-            END DO
-         END DO
+         DO_2D_10_10
+            zstokes_psi_u_top(ji,jj) = 0._wp
+            zstokes_psi_v_top(ji,jj) = 0._wp
+         END_2D
          zsqrtpi = SQRT(rpi)
          z_two_thirds = 2.0_wp / 3.0_wp
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  zbot_u = ( gdepw_n(ji,jj,jk+1) + gdepw_n(ji+1,jj,jk+1) )  ! 2 * bottom depth
-                  zbot_v = ( gdepw_n(ji,jj,jk+1) + gdepw_n(ji,jj+1,jk+1) )  ! 2 * bottom depth
-                  zkb_u  = zk_u(ji,jj) * zbot_u                             ! 2 * k * bottom depth
-                  zkb_v  = zk_v(ji,jj) * zbot_v                             ! 2 * k * bottom depth
-                  !
-                  zke3_u = MAX(1.e-8_wp, 2.0_wp * zk_u(ji,jj) * e3u_n(ji,jj,jk))     ! 2k * thickness
-                  zke3_v = MAX(1.e-8_wp, 2.0_wp * zk_v(ji,jj) * e3v_n(ji,jj,jk))     ! 2k * thickness
-
-                  ! Depth attenuation .... do u component first..
-                  zdepth      = zkb_u
-                  zsqrt_depth = SQRT(zdepth)
-                  zexp_depth  = EXP(-zdepth)
-                  zstokes_psi_u_bot = 1.0_wp - zexp_depth  &
-                       &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) &
-                       &              + 1.0_wp - (1.0_wp + zdepth)*zexp_depth )
-                  zda_u                    = ( zstokes_psi_u_bot - zstokes_psi_u_top(ji,jj) ) / zke3_u
-                  zstokes_psi_u_top(ji,jj) =   zstokes_psi_u_bot
-
-                  !         ... and then v component
-                  zdepth      =zkb_v
-                  zsqrt_depth = SQRT(zdepth)
-                  zexp_depth  = EXP(-zdepth)
-                  zstokes_psi_v_bot = 1.0_wp - zexp_depth  &
-                       &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) &
-                       &              + 1.0_wp - (1.0_wp + zdepth)*zexp_depth )
-                  zda_v                    = ( zstokes_psi_v_bot - zstokes_psi_v_top(ji,jj) ) / zke3_v
-                  zstokes_psi_v_top(ji,jj) =   zstokes_psi_v_bot
-                  !
-                  usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)
-                  vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
+         DO_3D_00_00( 1, jpkm1 )
+            zbot_u = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji+1,jj,jk+1,Kmm) )  ! 2 * bottom depth
+            zbot_v = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji,jj+1,jk+1,Kmm) )  ! 2 * bottom depth
+            zkb_u  = zk_u(ji,jj) * zbot_u                             ! 2 * k * bottom depth
+            zkb_v  = zk_v(ji,jj) * zbot_v                             ! 2 * k * bottom depth
+            !
+            zke3_u = MAX(1.e-8_wp, 2.0_wp * zk_u(ji,jj) * e3u(ji,jj,jk,Kmm))     ! 2k * thickness
+            zke3_v = MAX(1.e-8_wp, 2.0_wp * zk_v(ji,jj) * e3v(ji,jj,jk,Kmm))     ! 2k * thickness
+
+            ! Depth attenuation .... do u component first..
+            zdepth      = zkb_u
+            zsqrt_depth = SQRT(zdepth)
+            zexp_depth  = EXP(-zdepth)
+            zstokes_psi_u_bot = 1.0_wp - zexp_depth  &
+                 &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) &
+                 &              + 1.0_wp - (1.0_wp + zdepth)*zexp_depth )
+            zda_u                    = ( zstokes_psi_u_bot - zstokes_psi_u_top(ji,jj) ) / zke3_u
+            zstokes_psi_u_top(ji,jj) =   zstokes_psi_u_bot
+
+            !         ... and then v component
+            zdepth      =zkb_v
+            zsqrt_depth = SQRT(zdepth)
+            zexp_depth  = EXP(-zdepth)
+            zstokes_psi_v_bot = 1.0_wp - zexp_depth  &
+                 &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) &
+                 &              + 1.0_wp - (1.0_wp + zdepth)*zexp_depth )
+            zda_v                    = ( zstokes_psi_v_bot - zstokes_psi_v_top(ji,jj) ) / zke3_v
+            zstokes_psi_v_top(ji,jj) =   zstokes_psi_v_bot
+            !
+            usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)
+            vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)
+         END_3D
          DEALLOCATE( zstokes_psi_u_top, zstokes_psi_v_top )
       ENDIF
@@ -220 +203 @@
       !                       !==  vertical Stokes Drift 3D velocity  ==!
       !
-      DO jk = 1, jpkm1               ! Horizontal e3*divergence
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi
-               ze3divh(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * usd(ji  ,jj,jk)    &
-                  &                 - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * usd(ji-1,jj,jk)    &
-                  &                 + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vsd(ji,jj  ,jk)    &
-                  &                 - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vsd(ji,jj-1,jk)  ) * r1_e1e2t(ji,jj)
-            END DO
-         END DO
-      END DO
+      DO_3D_01_01( 1, jpkm1 )
+         ze3divh(ji,jj,jk) = (  e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * usd(ji  ,jj,jk)    &
+            &                 - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * usd(ji-1,jj,jk)    &
+            &                 + e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * vsd(ji,jj  ,jk)    &
+            &                 - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vsd(ji,jj-1,jk)  ) * r1_e1e2t(ji,jj)
+      END_3D
       !
 #if defined key_agrif
@@ -291 +270 @@
       !
       IF( ln_tauw ) THEN
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               ! Stress components at u- & v-points
-               utau(ji,jj) = 0.5_wp * ( tauw_x(ji,jj) + tauw_x(ji+1,jj) )
-               vtau(ji,jj) = 0.5_wp * ( tauw_y(ji,jj) + tauw_y(ji,jj+1) )
-               !
-               ! Stress module at t points
-               taum(ji,jj) = SQRT( tauw_x(ji,jj)*tauw_x(ji,jj) + tauw_y(ji,jj)*tauw_y(ji,jj) )
-            END DO
-         END DO
+         DO_2D_10_10
+            ! Stress components at u- & v-points
+            utau(ji,jj) = 0.5_wp * ( tauw_x(ji,jj) + tauw_x(ji+1,jj) )
+            vtau(ji,jj) = 0.5_wp * ( tauw_y(ji,jj) + tauw_y(ji,jj+1) )
+            !
+            ! Stress module at t points
+            taum(ji,jj) = SQRT( tauw_x(ji,jj)*tauw_x(ji,jj) + tauw_y(ji,jj)*tauw_y(ji,jj) )
+         END_2D
          CALL lbc_lnk_multi( 'sbcwave', utau(:,:), 'U', -1. , vtau(:,:), 'V', -1. , taum(:,:) , 'T', -1. )
       ENDIF
@@ -307 +284 @@
 
 
-   SUBROUTINE sbc_wave( kt )
+   SUBROUTINE sbc_wave( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE sbc_wave  ***
@@ -322 +299 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in   ) ::   kt   ! ocean time step
+      INTEGER, INTENT(in   ) ::   Kmm  ! ocean time index
       !!---------------------------------------------------------------------
       !
@@ -361 +339 @@
          !
          IF( ( ll_st_bv_li   .AND. jp_hsw>0 .AND. jp_wmp>0 .AND. jp_usd>0 .AND. jp_vsd>0 ) .OR. &
-           & ( ll_st_peakfr  .AND. jp_wfr>0 .AND. jp_usd>0 .AND. jp_vsd>0                ) ) CALL sbc_stokes()
+           & ( ll_st_peakfr  .AND. jp_wfr>0 .AND. jp_usd>0 .AND. jp_vsd>0                ) ) CALL sbc_stokes( Kmm )
          !
       ENDIF
@@ -395 +373 @@
       !!---------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namsbc_wave in reference namelist : File for drag coeff. from wave model
       READ  ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_wave in reference namelist' )
          
-      REWIND( numnam_cfg )              ! Namelist namsbc_wave in configuration namelist : File for drag coeff. from wave model
       READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist' )

@@ -3 +3 @@
 ^/utils/build/mk@HEAD         mk
 ^/utils/tools@HEAD            tools
-^/vendors/AGRIF/dev@HEAD      ext/AGRIF
+^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL