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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_sbc.F90 – NEMO

Ignore:
Timestamp:
2020-05-14T21:46:00+02:00 (4 years ago)
Author:
smueller
Message:

Synchronizing with /NEMO/trunk@12925 (ticket #2170)

Location:
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

    • Property svn:externals
      •  

        old new  
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@HEAD         sette 
  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/USR/usrdef_sbc.F90

    r10425 r12928  
    3131 
    3232   !! * Substitutions 
    33 #  include "vectopt_loop_substitute.h90" 
     33#  include "do_loop_substitute.h90" 
    3434   !!---------------------------------------------------------------------- 
    3535   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    3939CONTAINS 
    4040 
    41    SUBROUTINE usrdef_sbc_oce( kt ) 
     41   SUBROUTINE usrdef_sbc_oce( kt, Kbb ) 
    4242      !!--------------------------------------------------------------------- 
    4343      !!                    ***  ROUTINE usrdef_sbc  *** 
     
    5555      !!---------------------------------------------------------------------- 
    5656      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     57      INTEGER, INTENT(in) ::   Kbb  ! ocean time index 
    5758      !! 
    5859      INTEGER  ::   ji, jj                 ! dummy loop indices 
     
    8889 
    8990      ! current day (in hours) since january the 1st of the current year 
    90       ztime = REAL( kt ) * rdt / (rmmss * rhhmm)   &       !  total incrementation (in hours) 
     91      ztime = REAL( kt ) * rn_Dt / (rmmss * rhhmm)   &       !  total incrementation (in hours) 
    9192         &      - (nyear  - 1) * rjjhh * zyydd             !  minus years since beginning of experiment (in hours) 
    9293 
     
    109110      ztrp= - 40.e0        ! retroaction term on heat fluxes (W/m2/K) 
    110111      zconv = 3.16e-5      ! convertion factor: 1 m/yr => 3.16e-5 mm/s 
    111       DO jj = 1, jpj 
    112          DO ji = 1, jpi 
    113             ! domain from 15 deg to 50 deg between 27 and 28  degC at 15N, -3 
    114             ! and 13 degC at 50N 53.5 + or - 11 = 1/4 period : 
    115             ! 64.5 in summer, 42.5 in winter 
    116             t_star = zTstar * ( 1. + 1. / 50. * zcos_sais2 )                & 
    117                &                    * COS( rpi * (gphit(ji,jj) - 5.)               & 
    118                &                    / ( 53.5 * ( 1 + 11 / 53.5 * zcos_sais2 ) * 2.) ) 
    119             ! 23.5 deg : tropics 
    120             qsr (ji,jj) =  230 * COS( 3.1415 * ( gphit(ji,jj) - 23.5 * zcos_sais1 ) / ( 0.9 * 180 ) ) 
    121             qns (ji,jj) = ztrp * ( tsb(ji,jj,1,jp_tem) - t_star ) - qsr(ji,jj) 
    122             IF( gphit(ji,jj) >= 14.845 .AND. 37.2 >= gphit(ji,jj) ) THEN    ! zero at 37.8 deg, max at 24.6 deg 
    123                emp  (ji,jj) =   zemp_S * zconv   & 
    124                   &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (24.6 - 37.2) )  & 
    125                   &         * ( 1 - zemp_sais / zemp_S * zcos_sais1) 
    126             ELSE 
    127                emp (ji,jj) =  - zemp_N * zconv   & 
    128                   &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (46.8 - 37.2) )  & 
    129                   &         * ( 1 - zemp_sais / zemp_N * zcos_sais1 ) 
    130             ENDIF 
    131          END DO 
    132       END DO 
     112      DO_2D_11_11 
     113         ! domain from 15 deg to 50 deg between 27 and 28  degC at 15N, -3 
     114         ! and 13 degC at 50N 53.5 + or - 11 = 1/4 period : 
     115         ! 64.5 in summer, 42.5 in winter 
     116         t_star = zTstar * ( 1. + 1. / 50. * zcos_sais2 )                & 
     117            &                    * COS( rpi * (gphit(ji,jj) - 5.)               & 
     118            &                    / ( 53.5 * ( 1 + 11 / 53.5 * zcos_sais2 ) * 2.) ) 
     119         ! 23.5 deg : tropics 
     120         qsr (ji,jj) =  230 * COS( 3.1415 * ( gphit(ji,jj) - 23.5 * zcos_sais1 ) / ( 0.9 * 180 ) ) 
     121         qns (ji,jj) = ztrp * ( ts(ji,jj,1,jp_tem,Kbb) - t_star ) - qsr(ji,jj) 
     122         IF( gphit(ji,jj) >= 14.845 .AND. 37.2 >= gphit(ji,jj) ) THEN    ! zero at 37.8 deg, max at 24.6 deg 
     123            emp  (ji,jj) =   zemp_S * zconv   & 
     124               &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (24.6 - 37.2) )  & 
     125               &         * ( 1 - zemp_sais / zemp_S * zcos_sais1) 
     126         ELSE 
     127            emp (ji,jj) =  - zemp_N * zconv   & 
     128               &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (46.8 - 37.2) )  & 
     129               &         * ( 1 - zemp_sais / zemp_N * zcos_sais1 ) 
     130         ENDIF 
     131      END_2D 
    133132 
    134133      zsumemp = GLOB_SUM( 'usrdef_sbc', emp  (:,:)   )  
     
    155154      !accumulates days of previous months of this year 
    156155      ! day (in hours) since january the 1st 
    157       ztime = FLOAT( kt ) * rdt / (rmmss * rhhmm)  &  ! incrementation in hour 
     156      ztime = FLOAT( kt ) * rn_Dt / (rmmss * rhhmm)  &  ! incrementation in hour 
    158157         &     - (nyear - 1) * rjjhh * zyydd          !  - nber of hours the precedent years 
    159158      ztimemax = ((5.*30.)+21.)* 24.               ! 21th june     in hours 
     
    166165      ztau_sais = 0.015 
    167166      ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi ) 
    168       DO jj = 1, jpj 
    169          DO ji = 1, jpi 
    170            ! domain from 15deg to 50deg and 1/2 period along 14deg 
    171            ! so 5/4 of half period with seasonal cycle 
    172            utau(ji,jj) = - ztaun * SIN( rpi * (gphiu(ji,jj) - 15.) / (29.-15.) ) 
    173            vtau(ji,jj) =   ztaun * SIN( rpi * (gphiv(ji,jj) - 15.) / (29.-15.) ) 
    174          END DO 
    175       END DO 
     167      DO_2D_11_11 
     168        ! domain from 15deg to 50deg and 1/2 period along 14deg 
     169        ! so 5/4 of half period with seasonal cycle 
     170        utau(ji,jj) = - ztaun * SIN( rpi * (gphiu(ji,jj) - 15.) / (29.-15.) ) 
     171        vtau(ji,jj) =   ztaun * SIN( rpi * (gphiv(ji,jj) - 15.) / (29.-15.) ) 
     172      END_2D 
    176173 
    177174      ! module of wind stress and wind speed at T-point 
    178175      zcoef = 1. / ( zrhoa * zcdrag )  
    179       DO jj = 2, jpjm1 
    180          DO ji = fs_2, fs_jpim1   ! vect. opt. 
    181             ztx = utau(ji-1,jj  ) + utau(ji,jj)  
    182             zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
    183             zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 
    184             taum(ji,jj) = zmod 
    185             wndm(ji,jj) = SQRT( zmod * zcoef ) 
    186          END DO 
    187       END DO 
     176      DO_2D_00_00 
     177         ztx = utau(ji-1,jj  ) + utau(ji,jj)  
     178         zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
     179         zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 
     180         taum(ji,jj) = zmod 
     181         wndm(ji,jj) = SQRT( zmod * zcoef ) 
     182      END_2D 
    188183      CALL lbc_lnk_multi( 'usrdef_sbc', taum(:,:), 'T', 1. , wndm(:,:), 'T', 1. ) 
    189184 
Note: See TracChangeset for help on using the changeset viewer.