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

Changeset 5654


Ignore:
Timestamp:
2015-07-30T18:45:28+02:00 (9 years ago)
Author:
deazer
Message:

Added in changes to allow CO5 like run to verify CO6 with NEMO STABLE VN3.6

Location:
branches/UKMO/2015_V36_STABLE_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC
Files:
2 added
9 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/2015_V36_STABLE_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r5650 r5654  
    176176   LOGICAL, PUBLIC ::   ln_zps        !: z-coordinate - partial step 
    177177   LOGICAL, PUBLIC ::   ln_sco        !: s-coordinate or hybrid z-s coordinate 
     178   LOGICAL, PUBLIC ::   ln_read_zenv  !: Read or Calcualte zenv 
    178179   LOGICAL, PUBLIC ::   ln_isfcav     !: presence of ISF  
    179180 
     
    245246   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m) 
    246247   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rx1                !: Maximum grid stiffness ratio 
     248   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zenv               !: Envelope Bathymetry 
    247249 
    248250   !!---------------------------------------------------------------------- 
     
    392394         &     tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), & 
    393395         &     bmask(jpi,jpj)   ,                                                       & 
    394          &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 
     396         &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , zenv(jpi,jpj) , STAT=ierr(9) ) 
    395397 
    396398! (ISF) Allocation of basic array    
  • branches/UKMO/2015_V36_STABLE_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5650 r5654  
    102102      INTEGER ::   ios 
    103103      ! 
    104       NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 
     104      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_read_zenv 
    105105      !!---------------------------------------------------------------------- 
    106106      ! 
     
    125125         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco 
    126126         WRITE(numout,*) '             ice shelf cavities             ln_isfcav = ', ln_isfcav 
     127         WRITE(numout,*) '             Read zenv from Bathy T/F ln_read_zenv    = ', ln_read_zenv 
    127128      ENDIF 
    128129 
     
    518519            ELSE 
    519520               CALL iom_get  ( inum, jpdom_data, 'Bathymetry'    , bathy, lrowattr=ln_use_jattr  ) 
     521               IF ( ln_read_zenv ) THEN                  ! Whether we should read zenv or not 
     522                   CALL iom_get  ( inum, jpdom_data, 'zenv', zenv ) 
     523               ENDIF 
    520524            END IF 
    521525            CALL iom_close( inum ) 
     
    17981802      ! 
    17991803      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 
    1800       REAL(wp), POINTER, DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat 
     1804      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztmp, zmsk, zri, zrj, zhbat 
    18011805 
    18021806      NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & 
     
    18601864      !                                        ! ============================= 
    18611865      ! use r-value to create hybrid coordinates 
     1866      scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea) 
     1867      scobot(:,:) = bathy(:,:)        ! ocean bottom  depth 
     1868      IF( ln_read_zenv) THEN 
     1869           WRITE(numout,*) '      Zenv is not calculated but read from Bathy File ln_read_zenv        = ', ln_read_zenv 
     1870      ELSE 
    18621871      zenv(:,:) = bathy(:,:) 
    18631872      ! 
     
    18811890      !  
    18821891      ! smooth the bathymetry (if required) 
    1883       scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea) 
    1884       scobot(:,:) = bathy(:,:)        ! ocean bottom  depth 
    18851892      ! 
    18861893      jl = 0 
     
    19461953      END DO                                                !     End loop     ! 
    19471954      !                                                     ! ================ ! 
     1955      ENDIF ! End of IF Block for reading in zenv 
     1956      CALL lbc_lnk( zenv, 'T', 1._wp, 'no0' ) 
    19481957      DO jj = 1, jpj 
    19491958         DO ji = 1, jpi 
     
    22212230      END DO 
    22222231      ! 
    2223       CALL wrk_dealloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 
     2232      CALL wrk_dealloc( jpi, jpj, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 
    22242233      ! 
    22252234      IF( nn_timing == 1 )  CALL timing_stop('zgr_sco') 
  • branches/UKMO/2015_V36_STABLE_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r5650 r5654  
    121121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s] 
    122122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1) 
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pressnow          !: UKMO SHELF pressure 
     124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   apgu              !: UKMO SHELF pressure forcing 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   apgv              !: UKMO SHELF pressure forcing 
    123126#if defined key_cpl_carbon_cycle 
    124127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm] 
     
    171174#endif 
    172175         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      & 
     176         &      pressnow(jpi,jpj), apgu(jpi,jpj)    , apgv(jpi,jpj) ,     & 
    173177         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 
    174178         ! 
  • branches/UKMO/2015_V36_STABLE_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r5650 r5654  
    2828   PUBLIC sbc_flx       ! routine called by step.F90 
    2929 
    30    INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read  
     30   INTEGER , PARAMETER ::   jpfld   = 6   ! maximum number of files to read  
    3131   INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file 
    3232   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file 
     
    3434   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file 
    3535   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file 
     36   INTEGER , PARAMETER ::   jp_press = 6  ! index of pressure for UKMO shelf fluxes 
    3637   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
     38   LOGICAL , PUBLIC    ::   ln_shelf_flx = .FALSE. ! UKMO SHELF specific flux flag 
     39   INTEGER             ::   jpfld_local   ! maximum number of files to 
     40read (locally modified depending on ln_shelf_flx)  
    3741 
    3842   !! * Substitutions 
     
    8286      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient 
    8387      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables 
     88      REAL     ::   cs                    ! UKMO SHELF: Friction co-efficient at surface 
     89      REAL     ::   totwindspd            ! UKMO SHELF: Magnitude of wind speed vector 
     90 
     91      REAL(wp) ::   rhoa  = 1.22         ! Air density kg/m3 
     92      REAL(wp) ::   cdrag = 1.5e-3       ! drag coefficient  
    8493      !! 
    8594      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files 
    8695      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures 
    87       TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read 
    88       NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 
     96      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, sn_press  !  informations about the fields to be read 
     97      LOGICAL     ::   ln_foam_flx  = .FALSE.                     ! UKMO FOAM specific flux flag 
     98      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp,   & 
     99      &                    ln_foam_flx, sn_press, ln_shelf_flx 
    89100      !!--------------------------------------------------------------------- 
    90101      ! 
     
    109120         slf_i(jp_emp ) = sn_emp 
    110121         ! 
    111          ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
     122            ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
     123            IF( ln_shelf_flx ) slf_i(jp_press) = sn_press 
     124    
     125            ! define local jpfld depending on shelf_flx logical 
     126            IF( ln_shelf_flx ) THEN 
     127               jpfld_local = jpfld 
     128            ELSE 
     129               jpfld_local = jpfld-1 
     130            ENDIF 
     131            ! 
     132            ALLOCATE( sf(jpfld_local), STAT=ierror )        ! set sf structure 
    112133         IF( ierror > 0 ) THEN    
    113134            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN   
     
    132153         ENDIF 
    133154!CDIR COLLAPSE 
     155            !!UKMO SHELF effect of atmospheric pressure on SSH 
     156            ! If using ln_apr_dyn, this is done there so don't repeat here. 
     157            IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN 
     158               DO jj = 1, jpjm1 
     159                  DO ji = 1, jpim1 
     160                     apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj) 
     161                     apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj) 
     162                  END DO 
     163               END DO 
     164            ENDIF ! ln_shelf_flx 
     165       
    134166         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields 
    135167            DO ji = 1, jpi 
    136                utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
    137                vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
    138                qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
    139                emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
     168                   IF( ln_shelf_flx ) THEN 
     169                      !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing 
     170                      pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1) 
     171                      !! UKMO SHELF flux files contain wind speed not wind stress 
     172                      totwindspd = sqrt((sf(jp_utau)%fnow(ji,jj,1))**2.0 + (sf(jp_vtau)%fnow(ji,jj,1))**2.0) 
     173                      cs = 0.63 + (0.066 * totwindspd) 
     174                      utau(ji,jj) = cs * (rhoa/rau0) * sf(jp_utau)%fnow(ji,jj,1) * totwindspd 
     175                      vtau(ji,jj) = cs * (rhoa/rau0) * sf(jp_vtau)%fnow(ji,jj,1) * totwindspd 
     176                   ELSE 
     177                      utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
     178                      vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
     179                   ENDIF 
     180                   qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 
     181                   IF( ln_foam_flx .OR. ln_shelf_flx ) THEN 
     182                      !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 
     183                      qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 
     184                      !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 
     185                      emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 
     186                   ELSE 
     187                      qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
     188                      emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
     189                   ENDIF 
    140190            END DO 
    141191         END DO 
     
    143193         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
    144194         ! 
     195    
     196            !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe 
     197            IF( ln_foam_flx ) THEN 
     198               CALL lbc_lnk( utau(:,:), 'U', -1. ) 
     199               CALL lbc_lnk( vtau(:,:), 'V', -1. ) 
     200            ENDIF 
     201     
    145202         !                                                        ! module of wind stress and wind speed at T-point 
    146203         zcoef = 1. / ( zrhoa * zcdrag ) 
     
    162219            WRITE(numout,*)  
    163220            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK' 
    164             DO jf = 1, jpfld 
     221            DO jf = 1, jpfld_local 
    165222               IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1. 
    166223               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1 
  • branches/UKMO/2015_V36_STABLE_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r5650 r5654  
    4242   LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term  
    4343   REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day] 
     44   LOGICAL         ::   ln_UKMO_haney   ! UKMO specific flag to calculate Haney forcing   
    4445 
    4546   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 
     
    95104            ! 
    96105            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
    97                DO jj = 1, jpj 
    98                   DO ji = 1, jpi 
    99                      zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 
    100                      qns(ji,jj) = qns(ji,jj) + zqrp 
    101                      qrp(ji,jj) = zqrp 
    102                   END DO 
    103                END DO 
     106                  IF( ln_UKMO_haney ) THEN 
     107                     DO jj = 1, jpj 
     108                        DO ji = 1, jpi 
     109                           sst1   =  sst_m(ji,jj) 
     110                           sst2   =  sf_sst(1)%fnow(ji,jj,1)    
     111                           e_sst1 = 10**((0.7859+0.03477*sst1)/(1.+0.00412*sst1)) 
     112                           e_sst2 = 10**((0.7859+0.03477*sst2)/(1.+0.00412*sst2))          
     113                           pr_tmp = 0.01*pressnow(ji,jj)  !pr_tmp = 1012.0 
     114                           qs1    = (0.62197*e_sst1)/(pr_tmp-0.378*e_sst1) 
     115                           qs2    = (0.62197*e_sst2)/(pr_tmp-0.378*e_sst2) 
     116                           hny_frc1(ji,jj) = sst1-sst2                    
     117                           hny_frc2(ji,jj) = qs1-qs2                      
     118                          !Might need to mask off land points. 
     119                           hny_frc1(ji,jj)=-hny_frc1(ji,jj)*wndm(ji,jj)*1.42 
     120                           hny_frc2(ji,jj)=-hny_frc2(ji,jj)*wndm(ji,jj)*4688.0 
     121                           qns(ji,jj)=qns(ji,jj)+hny_frc1(ji,jj)+hny_frc2(ji,jj)    
     122                           qrp(ji,jj) = 0.e0 
     123                        END DO 
     124                     END DO 
     125                  ELSE 
     126                     DO jj = 1, jpj 
     127                        DO ji = 1, jpi 
     128                           zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 
     129                           qns(ji,jj) = qns(ji,jj) + zqrp 
     130                           qrp(ji,jj) = zqrp 
     131                        END DO 
     132                     END DO 
     133                  ENDIF 
    104134               CALL iom_put( "qrp", qrp )                             ! heat flux damping 
    105135            ENDIF 
     
    163193      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
    164194      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
    165       NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 
     195      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd, ln_UKMO_haney 
    166196      INTEGER     ::  ios 
    167197      !!---------------------------------------------------------------------- 
     
    189219         WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd 
    190220         WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 
     221         WRITE(numout,*) '      Haney forcing                          ln_UKMO_haney = ', ln_UKMO_haney 
    191222      ENDIF 
    192223      ! 
  • branches/UKMO/2015_V36_STABLE_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r5650 r5654  
    2525   USE trd_oce         ! trends: ocean variables 
    2626   USE trdtra          ! trends manager: tracers  
     27   USE tradwl          ! solar radiation penetration (downwell method) 
    2728   ! 
    2829   USE in_out_manager  ! I/O manager 
     
    139140 
    140141!!gm      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration 
    141       IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration 
     142      IF( .NOT.ln_traqsr .and. .NOT.ln_tradwl ) THEN     ! no solar radiation penetration 
    142143         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns 
    143144         qsr(:,:) = 0.e0                     ! qsr set to zero 
  • branches/UKMO/2015_V36_STABLE_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5650 r5654  
    207207                                  CALL dyn_vor      ( kstp )   ! vorticity term including Coriolis 
    208208                                  CALL dyn_ldf      ( kstp )   ! lateral mixing 
     209          IF ( ln_shelf_flx .AND. & 
     210              & .NOT. ln_apr_dyn) CALL inv( kstp )             ! modification to vel from atmos pres  
    209211          IF( ln_neptsimp )       CALL dyn_nept_cor ( kstp )   ! add Neptune velocities (simplified) 
    210212#if defined key_agrif 
     
    252254                             CALL tra_sbc    ( kstp )       ! surface boundary condition 
    253255      IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr 
     256      IF( ln_tradwl      )   CALL tra_dwl    ( kstp )       ! Polcoms Style Short Wave Radiation  
    254257      IF( ln_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux 
    255258      IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme 
  • branches/UKMO/2015_V36_STABLE_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r5650 r5654  
    2525   USE sbcrnf           ! surface boundary condition: runoff variables 
    2626   USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step) 
     27   USE sbcflx           ! surface boundary condition: Fluxes 
    2728   USE sbc_oce          ! surface boundary condition: ocean 
    2829   USE sbctide          ! Tide initialisation 
     
    3031 
    3132   USE traqsr           ! solar radiation penetration      (tra_qsr routine) 
     33   USE tradwl           ! POLCOMS style solar radiation    (tra_dwl routine)  
    3234   USE trasbc           ! surface boundary condition       (tra_sbc routine) 
    3335   USE trabbc           ! bottom boundary condition        (tra_bbc routine) 
     
    6567 
    6668   USE sshwzv           ! vertical velocity and ssh        (ssh_nxt routine) 
     69   USE inv_bar_vel_mod  ! Atmos press effect on vel  
    6770   !                                                       (ssh_swp routine) 
    6871   !                                                       (wzv     routine) 
  • branches/UKMO/2015_V36_STABLE_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r5650 r5654  
    2727   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3         !: light absortion coefficient 
    2828   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   facvol        !: volume for degraded regions 
     29   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   rlambda2      !: Lambda2 for downwell version of Short wave Radiation 
     30   REAL(wp), PUBLIC                                      ::   rlambda       !: Lambda  for downwell version of Short wave Radiation 
    2931 
    3032#if defined key_top  
     
    7880      !!                  ***  trc_oce_alloc  *** 
    7981      !!---------------------------------------------------------------------- 
    80       INTEGER ::   ierr(2)        ! Local variables 
     82      INTEGER ::   ierr(3)        ! Local variables 
    8183      !!---------------------------------------------------------------------- 
    8284      ierr(:) = 0 
    8385                     ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) ) 
    8486      IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) ) 
     87                    ALLOCATE( rlambda2(jpi,jpj),   STAT=ierr(3) ) 
    8588      trc_oce_alloc  = MAXVAL( ierr ) 
    8689      ! 
    8790      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array') 
     91      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3, facvol or rlambda2 array') 
    8892   END FUNCTION trc_oce_alloc 
    8993 
Note: See TracChangeset for help on using the changeset viewer.