Changeset 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/sbcflx.F90

Timestamp:

2020-09-14T17:40:34+02:00 (4 years ago)

Author:

andmirek

Message:

Ticket #2195:update to trunk 13461

Location:

NEMO/branches/2019/dev_r11351_fldread_with_XIOS

Files:

• . (modified) (1 prop)
• src/OCE/SBC/sbcflx.F90 (modified) (4 diffs)

NEMO/branches/2019/dev_r11351_fldread_with_XIOS

@@ -3 +3 @@
 ^/utils/build/mk@HEAD         mk
 ^/utils/tools@HEAD            tools
-^/vendors/AGRIF/dev@HEAD      ext/AGRIF
+^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL
+
+# SETTE
+^/utils/CI/sette@13382        sette

@@ -3 +3 @@
 ^/utils/build/mk@HEAD         mk
 ^/utils/tools@HEAD            tools
-^/vendors/AGRIF/dev@HEAD      ext/AGRIF
+^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL
+
+# SETTE
+^/utils/CI/sette@13382        sette

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/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', lwp )
+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', lwp )
+902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist' )
          IF(lwm) WRITE ( numond, namsbc_flx ) 
          !
          !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing?
-         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   &
+         IF( ln_dm2dc .AND. sn_qsr%freqh /= 24. )   &
             &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
          !
@@ -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( 1, 1, 1, 1 )
+            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( 0, 0, 0, 0 )
+            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. )
+         CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1.0_wp )   ;   CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1.0_wp )
 
          IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked)

@@ -3 +3 @@
 ^/utils/build/mk@HEAD         mk
 ^/utils/tools@HEAD            tools
-^/vendors/AGRIF/dev@HEAD      ext/AGRIF
+^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF
 ^/vendors/FCM@HEAD            ext/FCM
 ^/vendors/IOIPSL@HEAD         ext/IOIPSL
+
+# SETTE
+^/utils/CI/sette@13382        sette