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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/SAS/sbcssm.F90 – NEMO

Ignore:
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:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/SAS/sbcssm.F90

    r10068 r13463  
    2626   USE lib_mpp        ! distributed memory computing library 
    2727   USE prtctl         ! print control 
    28    USE fldread        ! read input fields  
     28   USE fldread        ! read input fields 
    2929   USE timing         ! Timing 
    3030 
     
    3838   LOGICAL            ::   ln_3d_uve     ! specify whether input velocity data is 3D 
    3939   LOGICAL            ::   ln_read_frq   ! specify whether we must read frq or not 
    40     
     40 
    4141   LOGICAL            ::   l_sasread     ! Ice intilisation: =T read a file ; =F anaytical initilaistion 
    4242   LOGICAL            ::   l_initdone = .false. 
     
    6262CONTAINS 
    6363 
    64    SUBROUTINE sbc_ssm( kt ) 
     64   SUBROUTINE sbc_ssm( kt, Kbb, Kmm ) 
    6565      !!---------------------------------------------------------------------- 
    6666      !!                  ***  ROUTINE sbc_ssm  *** 
     
    6969      !!               for an off-line simulation using surface processes only 
    7070      !! 
    71       !! ** Method : calculates the position of data  
     71      !! ** Method : calculates the position of data 
    7272      !!             - interpolates data if needed 
    7373      !!---------------------------------------------------------------------- 
    7474      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     75      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
     76      ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    7577      ! 
    7678      INTEGER  ::   ji, jj     ! dummy loop indices 
     
    8082      ! 
    8183      IF( ln_timing )   CALL timing_start( 'sbc_ssm') 
    82       
     84 
    8385      IF ( l_sasread ) THEN 
    8486         IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d )      !==   read data at kt time step   ==! 
    8587         IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==! 
    86          !  
     88         ! 
    8789         IF( ln_3d_uve ) THEN 
    8890            IF( .NOT. ln_linssh ) THEN 
    89                e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor  
     91               e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
    9092            ELSE 
    9193               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor 
    9294            ENDIF 
    9395            ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    94             ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     96            ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
    9597         ELSE 
    9698            IF( .NOT. ln_linssh ) THEN 
    97                e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor  
     99               e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
    98100            ELSE 
    99101               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor 
    100102            ENDIF 
    101103            ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    102             ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     104            ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
    103105         ENDIF 
    104106         ! 
     
    119121         IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D 
    120122         frq_m(:,:) = 1._wp                              !              - - 
    121          sshn (:,:) = 0._wp                              !              - - 
    122       ENDIF 
    123        
     123         ssh  (:,:,Kmm) = 0._wp                              !              - - 
     124      ENDIF 
     125 
    124126      IF ( nn_ice == 1 ) THEN 
    125          tsn(:,:,1,jp_tem) = sst_m(:,:) 
    126          tsn(:,:,1,jp_sal) = sss_m(:,:) 
    127          tsb(:,:,1,jp_tem) = sst_m(:,:) 
    128          tsb(:,:,1,jp_sal) = sss_m(:,:) 
    129       ENDIF 
    130       ub (:,:,1) = ssu_m(:,:) 
    131       vb (:,:,1) = ssv_m(:,:) 
    132   
    133       IF(ln_ctl) THEN                  ! print control 
     127         ts(:,:,1,jp_tem,Kmm) = sst_m(:,:) 
     128         ts(:,:,1,jp_sal,Kmm) = sss_m(:,:) 
     129         ts(:,:,1,jp_tem,Kbb) = sst_m(:,:) 
     130         ts(:,:,1,jp_sal,Kbb) = sss_m(:,:) 
     131      ENDIF 
     132      uu (:,:,1,Kbb) = ssu_m(:,:) 
     133      vv (:,:,1,Kbb) = ssv_m(:,:) 
     134 
     135      IF(sn_cfctl%l_prtctl) THEN            ! print control 
    134136         CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m   - : ', mask1=tmask   ) 
    135137         CALL prt_ctl(tab2d_1=sss_m, clinfo1=' sss_m   - : ', mask1=tmask   ) 
     
    156158 
    157159 
    158    SUBROUTINE sbc_ssm_init 
     160   SUBROUTINE sbc_ssm_init( Kbb, Kmm ) 
    159161      !!---------------------------------------------------------------------- 
    160162      !!                  ***  ROUTINE sbc_ssm_init  *** 
    161163      !! 
    162       !! ** Purpose :   Initialisation of sea surface mean data      
    163       !!---------------------------------------------------------------------- 
     164      !! ** Purpose :   Initialisation of sea surface mean data 
     165      !!---------------------------------------------------------------------- 
     166      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
     167      ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    164168      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code 
    165169      INTEGER  :: ifpr                               ! dummy loop indice 
     
    186190      ENDIF 
    187191      ! 
    188       REWIND( numnam_ref )              ! Namelist namsbc_sas in reference namelist : Input fields 
    189192      READ  ( numnam_ref, namsbc_sas, IOSTAT = ios, ERR = 901) 
    190 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_sas in reference namelist', lwp ) 
    191       REWIND( numnam_cfg )              ! Namelist namsbc_sas in configuration namelist : Input fields 
     193901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_sas in reference namelist' ) 
    192194      READ  ( numnam_cfg, namsbc_sas, IOSTAT = ios, ERR = 902 ) 
    193 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist', lwp ) 
     195902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' ) 
    194196      IF(lwm) WRITE ( numond, namsbc_sas ) 
    195       !            
     197      ! 
    196198      IF(lwp) THEN                              ! Control print 
    197199         WRITE(numout,*) '   Namelist namsbc_sas' 
    198          WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread  
     200         WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread 
    199201         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve 
    200202         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq 
     
    224226         ln_closea = .false. 
    225227      ENDIF 
    226        
    227       !                   
     228 
     229      ! 
    228230      IF( l_sasread ) THEN                       ! store namelist information in an array 
    229          !  
     231         ! 
    230232         !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 
    231233         !! when we have other 3d arrays that we need to read in 
     
    273275         ENDIF 
    274276         ! 
    275          ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false.  
     277         ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false. 
    276278         IF( nfld_3d > 0 ) THEN 
    277279            ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure 
     
    280282            ENDIF 
    281283            DO ifpr = 1, nfld_3d 
    282                                             ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 ) 
     284               ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 ) 
    283285               IF( slf_3d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2)  , STAT=ierr1 ) 
    284286               IF( ierr0 + ierr1 > 0 ) THEN 
     
    288290            !                                         ! fill sf with slf_i and control print 
    289291            CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' ) 
     292            sf_ssm_3d(jf_usp)%cltype = 'U'   ;   sf_ssm_3d(jf_usp)%zsgn = -1._wp 
     293            sf_ssm_3d(jf_vsp)%cltype = 'V'   ;   sf_ssm_3d(jf_vsp)%zsgn = -1._wp 
    290294         ENDIF 
    291295         ! 
     
    296300            ENDIF 
    297301            DO ifpr = 1, nfld_2d 
    298                                             ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 ) 
     302               ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 ) 
    299303               IF( slf_2d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 ) 
    300304               IF( ierr0 + ierr1 > 0 ) THEN 
     
    304308            ! 
    305309            CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' ) 
     310            IF( .NOT. ln_3d_uve ) THEN 
     311               sf_ssm_2d(jf_usp)%cltype = 'U'   ;   sf_ssm_2d(jf_usp)%zsgn = -1._wp 
     312               sf_ssm_2d(jf_vsp)%cltype = 'V'   ;   sf_ssm_2d(jf_vsp)%zsgn = -1._wp 
     313            ENDIF 
    306314         ENDIF 
    307315         ! 
     
    311319      ENDIF 
    312320      ! 
    313       CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in iceistate 
     321      CALL sbc_ssm( nit000, Kbb, Kmm )   ! need to define ss?_m arrays used in iceistate 
    314322      l_initdone = .TRUE. 
    315323      ! 
Note: See TracChangeset for help on using the changeset viewer.