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 15455 – NEMO

Changeset 15455


Ignore:
Timestamp:
2021-10-28T11:23:37+02:00 (7 months ago)
Author:
jcastill
Message:

Code for uncoupled configurations, some changes for coupling may be needed yet - merged branch branches/UKMO/r14075_cpl-pressure@15423

Location:
NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE
Files:
1 added
10 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbc_oce.F90

    r14075 r15455  
    134134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s] 
    135135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1) 
     136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pressnow          !: UKMO SHELF pressure  
     137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   apgu              !: UKMO SHELF pressure forcing  
     138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   apgv              !: UKMO SHELF pressure forcing 
    136139   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm] 
    137140   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 
     
    180183         ! 
    181184      ALLOCATE( tprecip(jpi,jpj) , sprecip  (jpi,jpj) , fr_i(jpi,jpj) ,   & 
     185         &      pressnow(jpi,jpj), apgu(jpi,jpj)      , apgv(jpi,jpj) ,   & 
    182186         &      atm_co2(jpi,jpj) , cloud_fra(jpi,jpj) ,                   & 
    183187         &      ssu_m  (jpi,jpj) , sst_m    (jpi,jpj) , frq_m(jpi,jpj) ,  & 
  • NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbcapr.F90

    r14075 r15455  
    1616   USE fldread         ! read input fields 
    1717   USE in_out_manager  ! I/O manager 
    18    USE lib_fortran     ! distribued memory computing library 
     18   USE lib_fortran     ! distributed memory computing library 
    1919   USE iom             ! IOM library 
    2020   USE lib_mpp         ! MPP library 
     
    2929   LOGICAL, PUBLIC ::   ln_apr_obc = .false.   !: inverse barometer added to OBC ssh data  
    3030   LOGICAL, PUBLIC ::   ln_ref_apr             !: ref. pressure: global mean Patm (F) or a constant (F) 
    31    REAL(wp)        ::   rn_pref                !  reference atmospheric pressure   [N/m2] 
     31   REAL(wp),PUBLIC ::   rn_pref                !  reference atmospheric pressure   [N/m2] 
    3232 
    3333   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ib    ! Inverse barometer now    sea surface height   [m] 
     
    3535   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   apr       ! atmospheric pressure at kt                 [N/m2] 
    3636    
    37    REAL(wp) ::   tarea                ! whole domain mean masked ocean surface 
    38    REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0) 
     37   REAL(wp), PUBLIC ::   tarea                 ! whole domain mean masked ocean surface  
     38   REAL(wp), PUBLIC ::   r1_grau               ! = 1.e0 / (grav * rau0) 
     39 
     40   LOGICAL, PUBLIC ::   cpl_mslp = .FALSE. ! Presure is passed via coupling 
    3941    
    4042   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read) 
     
    7880      IF(lwm) WRITE ( numond, namsbc_apr ) 
    7981      ! 
    80       ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
    81       IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' ) 
    82       ! 
    83       CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' ) 
     82      IF( .NOT. cpl_mslp ) THEN  
     83         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst  
     84         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' )  
     85         !  
     86         CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' ) 
    8487                                ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1)   ) 
    85       IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 
    86                              ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) ) 
    87                              ALLOCATE( apr (jpi,jpj) ) 
     88         IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) )  
     89      ENDIF  
     90                                ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) )  
     91                                ALLOCATE( apr (jpi,jpj) ) 
    8892      ! 
    8993      IF( lwp )THEN                                 !* control print 
    9094         WRITE(numout,*) 
    91          WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing' 
     95         IF( cpl_mslp ) THEN  
     96            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing'  
     97         ELSE    
     98            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric Pressure as extrenal forcing'    
     99         ENDIF 
    92100         WRITE(numout,*) '      ref. pressure: global mean Patm (T) or a constant (F)  ln_ref_apr = ', ln_ref_apr 
    93101      ENDIF 
     
    132140      !!---------------------------------------------------------------------- 
    133141 
    134       !                                         ! ========================== ! 
    135       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    At each sbc time-step   ! 
    136          !                                      ! ===========+++============ ! 
    137          ! 
    138          IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields 
    139          ! 
    140          CALL fld_read( kt, nn_fsbc, sf_apr )               !* input Patm provided at kt + nn_fsbc/2 
    141          ! 
    142          !                                                  !* update the reference atmospheric pressure (if necessary) 
    143          IF( ln_ref_apr )   rn_pref = glob_sum( 'sbcapr', sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea 
    144          ! 
    145          !                                                  !* Patm related forcing at kt 
    146          ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau    ! equivalent ssh (inverse barometer) 
    147          apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                        ! atmospheric pressure 
    148          ! 
    149          CALL iom_put( "ssh_ib", ssh_ib )                   !* output the inverse barometer ssh 
    150       ENDIF 
     142      IF( .NOT. cpl_mslp ) THEN   
     143                                                   ! ========================== !   
     144         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    At each sbc time-step   !   
     145            !                                      ! ===========+++============ !  
     146            IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields   
     147            !   
     148            CALL fld_read( kt, nn_fsbc, sf_apr )               !* input Patm provided at kt + nn_fsbc/2   
     149            !   
     150            !                                                  !* update the reference atmospheric pressure (if necessary)   
     151            IF( ln_ref_apr )   rn_pref = glob_sum( 'sbcapr', sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea   
     152            !   
     153            !                                                  !* Patm related forcing at kt   
     154            ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau    ! equivalent ssh (inverse barometer)   
     155            apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                          ! atmospheric pressure   
     156            !   
     157            CALL iom_put( "ssh_ib", ssh_ib )                   !* output the inverse barometer ssh  
     158         ENDIF 
    151159 
    152       !                                         ! ---------------------------------------- ! 
    153       IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    ! 
    154          !                                      ! ---------------------------------------- ! 
    155          !                                            !* Restart: read in restart file 
    156          IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN  
    157             IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file' 
    158             CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb, ldxios = lrxios )   ! before inv. barometer ssh 
    159             ! 
    160          ELSE                                         !* no restart: set from nit000 values 
    161             IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb set to nit000 values' 
    162             ssh_ibb(:,:) = ssh_ib(:,:) 
     160         !                                         ! ---------------------------------------- !   
     161         IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    !   
     162            !                                      ! ---------------------------------------- !   
     163            !                                            !* Restart: read in restart file   
     164            IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN    
     165               IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file'   
     166               CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh   
     167               !   
     168            ELSE                                         !* no restart: set from nit000 values   
     169               IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb set to nit000 values'   
     170               ssh_ibb(:,:) = ssh_ib(:,:)   
     171            ENDIF   
     172         ENDIF   
     173         !                                         ! ---------------------------------------- !   
     174         IF( lrst_oce ) THEN                       !      Write in the ocean restart file     !   
     175            !                                      ! ---------------------------------------- !   
     176            IF(lwp) WRITE(numout,*)   
     177            IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp   
     178            IF(lwp) WRITE(numout,*) '~~~~'   
     179            CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib )   
    163180         ENDIF 
    164       ENDIF 
    165       !                                         ! ---------------------------------------- ! 
    166       IF( lrst_oce ) THEN                       !      Write in the ocean restart file     ! 
    167          !                                      ! ---------------------------------------- ! 
    168          IF(lwp) WRITE(numout,*) 
    169          IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 
    170          IF(lwp) WRITE(numout,*) '~~~~' 
    171          IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    172          CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib, ldxios = lwxios ) 
    173181         IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    174182      ENDIF 
  • NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbccpl.F90

    r14075 r15455  
    209209#endif 
    210210 
    211    REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure[N/m2]  
    212    REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0)  
    213  
    214211   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nrcvinfo           ! OASIS info argument 
    215212 
     
    573570      !                                                      ! Mean Sea Level Pressure   !  
    574571      !                                                      ! ------------------------- !  
    575       srcv(jpr_mslp)%clname = 'O_MSLP'     ;   IF( TRIM(sn_rcv_mslp%cldes  ) == 'coupled' )    srcv(jpr_mslp)%laction = .TRUE.  
     572      srcv(jpr_mslp)%clname = 'O_MSLP'    
     573      IF( TRIM(sn_rcv_mslp%cldes  ) == 'coupled' ) THEN    
     574         srcv(jpr_mslp)%laction = .TRUE.    
     575         cpl_mslp = .TRUE.    
     576      ENDIF 
    576577      ! 
    577578      !                                                      ! ------------------------- ! 
     
    11221123      !!---------------------------------------------------------------------- 
    11231124      USE zdf_oce,  ONLY :   ln_zdfswm 
     1125      USE sbcssm ,  ONLY :   sbc_ssm_cpl    
     1126      USE lib_fortran     ! distributed memory computing library 
    11241127      ! 
    11251128      INTEGER, INTENT(in) ::   kt          ! ocean model time step index 
     
    12941297      !                                                      ! ========================= !  
    12951298      IF( srcv(jpr_mslp)%laction ) THEN                    ! UKMO SHELF effect of atmospheric pressure on SSH  
    1296           IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields  
    1297  
    1298           r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization  
    1299           ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer)  
    1300           apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                         !atmospheric pressure  
     1299          IF( ln_apr_dyn ) THEN   
     1300             IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)   !* Swap of ssh_ib fields 
    13011301     
    1302           IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible)  
     1302             !                                                  !* update the reference atmospheric pressure (if necessary)    
     1303             IF( ln_ref_apr )  rn_pref = glob_sum( 'sbccpl', frcv(jpr_mslp)%z3(:,:,1) * e1e2t(:,:) ) / tarea   
     1304 
     1305             ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rn_pref ) * r1_grau  ! equivalent ssh (inverse barometer)    
     1306             apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                        !atmospheric pressure    
     1307             !   
     1308             CALL iom_put( "ssh_ib", ssh_ib )                                  !* output the inverse barometer ssh   
     1309             !                                         ! ---------------------------------------- !    
     1310             IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    !    
     1311                !                                      ! ---------------------------------------- !    
     1312                !* Restart: read in restart file    
     1313                IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN    
     1314                   IF(lwp) WRITE(numout,*) 'sbc_cpl:   ssh_ibb read in the restart file'    
     1315                   CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh    
     1316                ELSE                                         !* no restart: set from nit000 values    
     1317                   IF(lwp) WRITE(numout,*) 'sbc_cpl:   ssh_ibb set to nit000 values'    
     1318                   ssh_ibb(:,:) = ssh_ib(:,:)    
     1319                ENDIF    
     1320             ENDIF    
     1321             !                                         ! ---------------------------------------- !    
     1322             IF( lrst_oce ) THEN                       !      Write in the ocean restart file     !    
     1323                !                                      ! ---------------------------------------- !    
     1324                IF(lwp) WRITE(numout,*)    
     1325                IF(lwp) WRITE(numout,*) 'sbc_cpl : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp    
     1326                IF(lwp) WRITE(numout,*) '~~~~'    
     1327                CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib )    
     1328             ENDIF    
     1329           ENDIF   
     1330         
     1331           ! Update mean ssh    
     1332           IF( nn_components /= jp_iam_sas ) CALL sbc_ssm_cpl( kt ) 
    13031333      END IF  
    13041334      ! 
  • NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbcflx.F90

    r14075 r15455  
    3535   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file 
    3636 !!INTEGER , PARAMETER ::   jp_sfx  = 6   ! index of salt flux flux 
    37    INTEGER , PARAMETER ::   jpfld   = 5 !! 6 ! maximum number of files to read  
     37   INTEGER , PARAMETER ::   jp_press = 6  ! index of pressure for UKMO shelf fluxes 
     38   INTEGER , PARAMETER ::   jpfld   = 6   ! maximum number of files to read  
    3839 
    3940   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
     41   LOGICAL , PUBLIC    ::   ln_shelf_flx = .FALSE. ! UKMO SHELF specific flux flag  
     42   LOGICAL , PUBLIC    ::   ln_rel_wind  = .FALSE. ! UKMO SHELF specific flux flag - relative winds 
     43   REAL(wp)            ::   rn_wfac                ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem) 
     44   INTEGER             ::   jpfld_local   ! maximum number of files to read (locally modified depending on ln_shelf_flx) 
    4045 
    4146   !! * Substitutions 
     
    8590      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient 
    8691      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables 
     92      REAL     ::   cs                    ! UKMO SHELF: Friction co-efficient at surface  
     93      REAL     ::   totwindspd            ! UKMO SHELF: Magnitude of wind speed vector  
     94      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwnd_i, zwnd_j    ! wind speed components at T-point 
     95     
     96      REAL(wp) ::   rhoa  = 1.22         ! Air density kg/m3  
     97      REAL(wp) ::   cdrag = 1.5e-3       ! drag coefficient 
    8798      !! 
    8899      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files 
    89100      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures 
    90       TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp !!, sn_sfx ! informations about the fields to be read 
    91       NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp !!, sn_sfx 
     101      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, sn_press  !  informations about the fields to be read  
     102      LOGICAL     ::   ln_foam_flx  = .FALSE.                     ! UKMO FOAM specific flux flag  
     103      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp,   &  
     104      &                    ln_foam_flx, sn_press, ln_shelf_flx, ln_rel_wind,    & 
     105      &                    rn_wfac 
    92106      !!--------------------------------------------------------------------- 
    93107      ! 
     
    112126         slf_i(jp_emp ) = sn_emp !! ;   slf_i(jp_sfx ) = sn_sfx 
    113127         ! 
    114          ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
     128         IF( ln_shelf_flx ) slf_i(jp_press) = sn_press  
     129  
     130         ! define local jpfld depending on shelf_flx logical  
     131         IF( ln_shelf_flx ) THEN  
     132            jpfld_local = jpfld  
     133         ELSE  
     134            jpfld_local = jpfld-1  
     135         ENDIF  
     136         !  
     137         ALLOCATE( sf(jpfld_local), STAT=ierror )        ! set sf structure  
    115138         IF( ierror > 0 ) THEN    
    116139            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN   
    117140         ENDIF 
    118          DO ji= 1, jpfld 
     141         DO ji= 1, jpfld_local 
    119142            ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 
    120143            IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) 
     
    129152      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency 
    130153 
     154         !!UKMO SHELF wind speed relative to surface currents 
     155         IF( ln_shelf_flx ) THEN 
     156            ALLOCATE( zwnd_i(jpi,jpj), zwnd_j(jpi,jpj) ) 
     157 
     158            IF( ln_rel_wind ) THEN 
     159               DO jj = 1, jpj 
     160                  DO ji = 1, jpi 
     161                     zwnd_i(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) - rn_wfac * ssu_m(ji,jj) 
     162                     zwnd_j(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) - rn_wfac * ssv_m(ji,jj) 
     163                  END DO 
     164               END DO 
     165            ELSE 
     166               zwnd_i(:,:) = sf(jp_utau)%fnow(:,:,1) 
     167               zwnd_j(:,:) = sf(jp_vtau)%fnow(:,:,1) 
     168            ENDIF 
     169         ENDIF 
     170 
    131171         IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)  ! modify now Qsr to include the diurnal cycle 
    132172         ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
    133173         ENDIF 
     174         !!UKMO SHELF effect of atmospheric pressure on SSH  
     175         ! If using ln_apr_dyn, this is done there so don't repeat here.  
     176         IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN  
     177            DO jj = 1, jpjm1  
     178               DO ji = 1, jpim1  
     179                  apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj)  
     180                  apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj)  
     181               END DO  
     182            END DO  
     183         ENDIF ! ln_shelf_flx 
    134184         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields 
    135185            DO ji = 1, jpi 
    136                utau(ji,jj) =   sf(jp_utau)%fnow(ji,jj,1)                              * umask(ji,jj,1) 
    137                vtau(ji,jj) =   sf(jp_vtau)%fnow(ji,jj,1)                              * vmask(ji,jj,1) 
    138                qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 
    139                emp (ji,jj) =   sf(jp_emp )%fnow(ji,jj,1)                              * tmask(ji,jj,1) 
     186                IF( ln_shelf_flx ) THEN  
     187                   !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing  
     188                   pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1)  
     189                   !! UKMO SHELF flux files contain wind speed not wind stress  
     190                   totwindspd = sqrt(zwnd_i(ji,jj)*zwnd_i(ji,jj) + zwnd_j(ji,jj)*zwnd_j(ji,jj)) 
     191                   cs = 0.63 + (0.066 * totwindspd)  
     192                   utau(ji,jj) = cs * (rhoa/rau0) * zwnd_i(ji,jj) * totwindspd 
     193                   vtau(ji,jj) = cs * (rhoa/rau0) * zwnd_j(ji,jj) * totwindspd 
     194                ELSE  
     195                   utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)  
     196                   vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)  
     197                ENDIF  
     198                qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1)  
     199                IF( ln_foam_flx .OR. ln_shelf_flx ) THEN  
     200                   !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot)  
     201                   qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1)  
     202                   !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P  
     203                   emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1)  
     204                ELSE  
     205                   qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)  
     206                   emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)  
     207                ENDIF 
    140208               !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1)                              * tmask(ji,jj,1)  
    141209            END DO 
    142210         END DO 
     211         ! 
     212         IF( ln_shelf_flx ) THEN 
     213            ! calculate first the wind module, as it will be used later 
     214            DO jj = 2, jpjm1 
     215               DO ji = fs_2, fs_jpim1    ! vect. opt. 
     216                  ztx = zwnd_i(ji-1,jj  ) + zwnd_i(ji,jj) 
     217                  zty = zwnd_j(ji  ,jj-1) + zwnd_j(ji,jj) 
     218                  wndm(ji,jj) = 0.5 * SQRT( ztx * ztx + zty * zty ) 
     219               END DO 
     220            END DO 
     221            CALL lbc_lnk_multi( 'sbcflx', wndm, 'T', 1. ) 
     222         ENDIF 
    143223         !                                                        ! add to qns the heat due to e-p 
    144          !clem: I do not think it is needed 
    145          !!qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
     224         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
    146225         ! 
    147226         ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x)  
     
    152231            WRITE(numout,*)  
    153232            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK' 
    154             DO jf = 1, jpfld 
     233            DO jf = 1, jpfld_local 
    155234               IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1. 
    156235               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1 
     
    164243      !                                                           ! module of wind stress and wind speed at T-point 
    165244      ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
     245      !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe  
     246      IF( ln_foam_flx ) THEN  
     247         CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp )  
     248      ENDIF 
    166249      zcoef = 1. / ( zrhoa * zcdrag ) 
    167250      DO jj = 2, jpjm1 
     
    171254            zmod = 0.5_wp * SQRT( ztx * ztx + zty * zty ) * tmask(ji,jj,1) 
    172255            taum(ji,jj) = zmod 
    173             wndm(ji,jj) = SQRT( zmod * zcoef )  !!clem: not used? 
     256            IF( .NOT. ln_shelf_flx ) THEN 
     257               wndm(ji,jj) = SQRT( zmod * zcoef )  !!clem: not used? 
     258            ENDIF 
    174259         END DO 
    175260      END DO 
     
    177262      CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 
    178263      ! 
     264      IF( ln_shelf_flx ) THEN 
     265         DEALLOCATE( zwnd_i, zwnd_j ) 
     266      ENDIF 
    179267      ! 
    180268   END SUBROUTINE sbc_flx 
  • NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbcmod.F90

    r14075 r15455  
    3939   USE sbcisf         ! surface boundary condition: ice-shelf 
    4040   USE sbccpl         ! surface boundary condition: coupled formulation 
     41   USE inv_bar_vel_mod! Atmos press effect on vel 
    4142   USE cpl_oasis3     ! OASIS routines for coupling 
    4243   USE sbcssr         ! surface boundary condition: sea surface restoring 
     
    391392      !!              - updte the ice fraction : fr_i 
    392393      !!---------------------------------------------------------------------- 
     394      USE sbcapr, ONLY: sbc_apr   
     395      USE bdydta, ONLY: bdy_dta   
     396      ! 
    393397      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    394398      ! 
     
    423427      !                                            !        forcing field computation         ! 
    424428      !                                            ! ---------------------------------------- ! 
     429      IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc   
     430                                                         ! (caution called before sbc_ssm) 
    425431      ! 
    426432      ll_sas = nn_components == jp_iam_sas               ! component flags 
     
    443449      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation 
    444450      CASE( jp_none    ) 
    445          IF( ll_opa    )      CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS 
     451         IF( .NOT. ln_mixcpl ) CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS 
    446452      END SELECT 
    447453      ! 
    448       IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing 
     454      IF( ln_mixcpl .OR. ( ln_wave .AND. nsbc .NE. jp_purecpl .AND. nsbc .NE. jp_none ) ) &  
     455                               CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing  
     456      IF ( ln_shelf_flx .AND. .NOT. ln_apr_dyn)                                           & 
     457                               CALL inv( kt )                               ! modification to vel from atmos pres 
     458      IF( ln_bdy )             CALL bdy_dta ( kt, kt_offset=+1 )            ! update dynamic & tracer data at open boundaries   
     459  
     460! (caution called after sbc_ssm[_cpl] and before ice) 
    449461      ! 
    450462      IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )      ! Wind stress provided by waves  
  • NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbcssm.F90

    r14075 r15455  
    2828 
    2929   PUBLIC   sbc_ssm        ! routine called by step.F90 
     30   PUBLIC   sbc_ssm_cpl    ! routine called by sbccpl.F90 
    3031   PUBLIC   sbc_ssm_init   ! routine called by sbcmod.F90 
    3132 
     
    7677         sss_m(:,:) = zts(:,:,jp_sal) 
    7778         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    78          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    79          ELSE                    ;   ssh_m(:,:) = sshn(:,:) 
     79         IF( .NOT. cpl_mslp ) THEN   
     80            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )   
     81            ELSE                    ;   ssh_m(:,:) = sshn(:,:)   
     82            ENDIF 
    8083         ENDIF 
    8184         ! 
     
    99102            sss_m(:,:) = zcoef * zts(:,:,jp_sal) 
    100103            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    101             IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    102             ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:) 
     104            IF( .NOT. cpl_mslp ) THEN   
     105               IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )   
     106               ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:)   
     107               ENDIF 
    103108            ENDIF 
    104109            ! 
     
    113118            sst_m(:,:) = 0._wp 
    114119            sss_m(:,:) = 0._wp 
    115             ssh_m(:,:) = 0._wp 
     120            IF( .NOT. cpl_mslp ) ssh_m(:,:) = 0._wp 
    116121            e3t_m(:,:) = 0._wp 
    117122            frq_m(:,:) = 0._wp 
     
    127132         sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 
    128133         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    129          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    130          ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 
     134         IF( .NOT. cpl_mslp ) THEN   
     135            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )   
     136            ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:)   
     137            ENDIF 
    131138         ENDIF 
    132139         ! 
     
    143150            ssu_m(:,:) = ssu_m(:,:) * zcoef     ! mean suface current  [m/s] 
    144151            ssv_m(:,:) = ssv_m(:,:) * zcoef     ! 
    145             ssh_m(:,:) = ssh_m(:,:) * zcoef     ! mean SSH             [m] 
     152            IF( .NOT. cpl_mslp ) ssh_m(:,:) = ssh_m(:,:) * zcoef     ! mean SSH             [m] 
    146153            e3t_m(:,:) = e3t_m(:,:) * zcoef     ! mean vertical scale factor [m] 
    147154            frq_m(:,:) = frq_m(:,:) * zcoef     ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
     
    162169            CALL iom_rstput( kt, nitrst, numrow, 'sst_m'  , sst_m, ldxios = lwxios  ) 
    163170            CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m, ldxios = lwxios  ) 
    164             CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m, ldxios = lwxios  ) 
     171            IF( .NOT. cpl_mslp ) CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m, ldxios = lwxios  ) 
    165172            CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m, ldxios = lwxios  ) 
    166173            CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m, ldxios = lwxios  ) 
     
    183190   END SUBROUTINE sbc_ssm 
    184191 
     192   SUBROUTINE sbc_ssm_cpl( kt )    
     193      !!---------------------------------------------------------------------    
     194      !!                   ***  ROUTINE sbc_ssm_cpl  ***    
     195      !!                         
     196      !! ** Purpose :   provide ocean surface variable to sea-surface boundary    
     197      !!                condition computation when pressure is read from coupling    
     198      !!                    
     199      !! ** Method  :   The inverse barometer ssh (i.e. ssh associated with Patm)    
     200      !!                is added to ssh_m when ln_apr_dyn = T. Required for sea-ice dynamics.    
     201      !!---------------------------------------------------------------------    
     202      INTEGER, INTENT(in) ::   kt   ! ocean time step    
     203      !    
     204      REAL(wp) ::   zcoef       ! local scalar    
     205      !!---------------------------------------------------------------------    
     206      !    
     207      IF( nn_fsbc == 1 ) THEN                             ! Instantaneous surface fields        !    
     208         !                                                ! ---------------------------------------- !    
     209         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )    
     210         ELSE                    ;   ssh_m(:,:) = sshn(:,:)    
     211         ENDIF    
     212      ELSE    
     213         !                                                ! ----------------------------------------------- !    
     214         IF( kt == nit000 .AND. .NOT. l_ssm_mean ) THEN   !   Initialisation: 1st time-step, no input means !    
     215            !                                             ! ----------------------------------------------- !    
     216            IF(lwp) WRITE(numout,*)    
     217            IF(lwp) WRITE(numout,*) '~~~~~~~   mean ssh field initialised to instantaneous values'    
     218            zcoef = REAL( nn_fsbc - 1, wp )    
     219            zcoef = REAL( nn_fsbc - 1, wp )    
     220            IF( ln_apr_dyn ) THEN    ;  ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )    
     221            ELSE                     ;  ssh_m(:,:) = zcoef * sshn(:,:)    
     222            ENDIF    
     223            !                                             ! ---------------------------------------- !    
     224         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   !    
     225            !                                             ! ---------------------------------------- !    
     226            ssh_m(:,:) = 0.e0    
     227         ENDIF    
     228      
     229         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )    
     230         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:)    
     231         ENDIF    
     232         !                                                ! ---------------------------------------- !    
     233         IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   !    
     234            !                                             ! ---------------------------------------- !    
     235            zcoef = 1. / REAL( nn_fsbc, wp )    
     236            ssh_m(:,:) = ssh_m(:,:) * zcoef           ! mean SSH [m]    
     237         ENDIF    
     238         !                                                ! ---------------------------------------- !    
     239         IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !    
     240            !                                             ! ---------------------------------------- !    
     241            IF(lwp) WRITE(numout,*)    
     242            IF(lwp) WRITE(numout,*) 'sbc_ssm_cpl : ssh mean field written in ocean restart file ',   &    
     243               &                    'at it= ', kt,' date= ', ndastp    
     244            IF(lwp) WRITE(numout,*) '~~~~~~~'    
     245            CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  )    
     246         ENDIF    
     247      ENDIF    
     248      !    
     249      IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   !    
     250         CALL iom_put( 'ssh_m', ssh_m )    
     251      ENDIF    
     252      !    
     253   END SUBROUTINE sbc_ssm_cpl 
    185254 
    186255   SUBROUTINE sbc_ssm_init 
  • NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbcssr.F90

    r14075 r15455  
    4444   REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day] 
    4545   INTEGER         ::   nn_sssr_ice     ! Control of restoring under ice 
     46   LOGICAL         ::   ln_UKMO_haney   ! UKMO specific flag to calculate Haney forcing 
    4647 
    4748   REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange 
     
    7980      INTEGER  ::   ierror   ! return error code 
    8081      !! 
     82      REAL(wp) ::   sst1,sst2                      ! sea surface temperature  
     83      REAL(wp) ::   e_sst1, e_sst2                 ! saturation vapour pressure  
     84      REAL(wp) ::   qs1,qs2                        ! specific humidity  
     85      REAL(wp) ::   pr_tmp                         ! temporary variable for pressure  
     86 
     87      REAL(wp), DIMENSION(jpi,jpj) ::  hny_frc1    ! Haney forcing for sensible heat, correction for latent heat     
     88      REAL(wp), DIMENSION(jpi,jpj) ::  hny_frc2    ! Haney forcing for sensible heat, correction for latent heat     
     89      !! 
    8190      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
    8291      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
     
    93102            ! 
    94103            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
    95                DO jj = 1, jpj 
    96                   DO ji = 1, jpi 
    97                      zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 
    98                      qns(ji,jj) = qns(ji,jj) + zqrp 
    99                      qrp(ji,jj) = zqrp 
    100                   END DO 
    101                END DO 
     104               IF( ln_UKMO_haney ) THEN  
     105                  DO jj = 1, jpj  
     106                     DO ji = 1, jpi  
     107                        sst1   =  sst_m(ji,jj)  
     108                        sst2   =  sf_sst(1)%fnow(ji,jj,1)     
     109                        e_sst1 = 10**((0.7859+0.03477*sst1)/(1.+0.00412*sst1))  
     110                        e_sst2 = 10**((0.7859+0.03477*sst2)/(1.+0.00412*sst2))           
     111                        pr_tmp = 0.01*pressnow(ji,jj)  !pr_tmp = 1012.0  
     112                        qs1    = (0.62197*e_sst1)/(pr_tmp-0.378*e_sst1)  
     113                        qs2    = (0.62197*e_sst2)/(pr_tmp-0.378*e_sst2)  
     114                        hny_frc1(ji,jj) = sst1-sst2                     
     115                        hny_frc2(ji,jj) = qs1-qs2                       
     116                       !Might need to mask off land points.  
     117                        hny_frc1(ji,jj)=-hny_frc1(ji,jj)*wndm(ji,jj)*1.42  
     118                        hny_frc2(ji,jj)=-hny_frc2(ji,jj)*wndm(ji,jj)*4688.0  
     119                        qns(ji,jj)=qns(ji,jj)+hny_frc1(ji,jj)+hny_frc2(ji,jj)     
     120                        qrp(ji,jj) = 0.e0  
     121                     END DO  
     122                  END DO  
     123               ELSE  
     124                  DO jj = 1, jpj  
     125                     DO ji = 1, jpi  
     126                        zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) )  
     127                        qns(ji,jj) = qns(ji,jj) + zqrp  
     128                        qrp(ji,jj) = zqrp  
     129                     END DO  
     130                  END DO  
     131               ENDIF 
    102132            ENDIF 
    103133            ! 
     
    170200      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
    171201      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, & 
    172               & sn_sss, ln_sssr_bnd, rn_sssr_bnd, nn_sssr_ice 
     202              & sn_sss, ln_sssr_bnd, rn_sssr_bnd, nn_sssr_ice, ln_UKMO_haney 
    173203      INTEGER     ::  ios 
    174204      !!---------------------------------------------------------------------- 
     
    202232         WRITE(numout,*) '          ( 1 = restoration everywhere  )' 
    203233         WRITE(numout,*) '          (>1 = enhanced restoration under ice  )' 
     234         WRITE(numout,*) '      Haney forcing                          ln_UKMO_haney  = ', ln_UKMO_haney 
    204235      ENDIF 
    205236      ! 
  • NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/step.F90

    r14075 r15455  
    109109      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    110110      IF( ln_tide    )   CALL sbc_tide( kstp )                   ! update tide potential 
    111       IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                   ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib)  
    112       IF( ln_bdy     )   CALL bdy_dta ( kstp, kt_offset = +1 )   ! update dynamic & tracer data at open boundaries 
    113111                         CALL sbc     ( kstp )                   ! Sea Boundary Condition (including sea-ice) 
    114112 
  • NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/step_oce.F90

    r14075 r15455  
    1818   USE sbcrnf          ! surface boundary condition: runoff variables 
    1919   USE sbccpl          ! surface boundary condition: coupled formulation (call send at end of step) 
     20   USE sbcflx           ! surface boundary condition: Fluxes 
    2021   USE sbcapr          ! surface boundary condition: atmospheric pressure 
    2122   USE sbctide         ! Tide initialisation 
  • NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/trc_oce.F90

    r14075 r15455  
    3030   ! 
    3131   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3     !: light absortion coefficient 
     32   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   rlambda2  !: Lambda2 for downwell version of Short wave Radiation  
     33   REAL(wp), PUBLIC                                      ::   rlambda   !: Lambda  for downwell version of Short wave Radiation 
    3234   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   oce_co2   !: ocean carbon flux 
    3335 
     
    5456      !!                  ***  trc_oce_alloc  *** 
    5557      !!---------------------------------------------------------------------- 
    56       ALLOCATE( etot3(jpi,jpj,jpk), oce_co2(jpi,jpj), STAT=trc_oce_alloc ) 
    57       IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array') 
     58      ALLOCATE( etot3(jpi,jpj,jpk), oce_co2(jpi,jpj), rlambda2(jpi,jpj), STAT=trc_oce_alloc ) 
     59      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 or rlambda2 array') 
    5860      ! 
    5961   END FUNCTION trc_oce_alloc 
Note: See TracChangeset for help on using the changeset viewer.