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

Changeset 5417


Ignore:
Timestamp:
2015-06-15T09:32:15+02:00 (9 years ago)
Author:
deazer
Message:

Rolling back previous commit to allow application of removal of svn keywords.
Changes will be brought back in afterward. This should then allwo fcm to merge
for rose build.

Location:
branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC
Files:
2 deleted
12 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r5389 r5417  
    177177   LOGICAL, PUBLIC ::   ln_sco        !: s-coordinate or hybrid z-s coordinate 
    178178   LOGICAL, PUBLIC ::   ln_isfcav     !: presence of ISF  
    179    LOGICAL, PUBLIC ::   ln_read_zenv  !:  whether to read zenv or calculate it 
    180179 
    181180   !! All coordinates 
    … …  
    246245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m) 
    247246   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rx1                !: Maximum grid stiffness ratio 
    248    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zenv               !: Envelope Bathymetry 
    249247 
    250248   !!---------------------------------------------------------------------- 
    … …  
    394392         &     tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), & 
    395393         &     bmask(jpi,jpj)   ,                                                       & 
    396          &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , zenv(jpi,jpj) , STAT=ierr(9) ) 
     394         &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 
    397395 
    398396! (ISF) Allocation of basic array    

  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r5389 r5417  
    146146         &             ppa2, ppkth2, ppacr2 
    147147      NAMELIST/namcla/ nn_cla 
    148       NAMELIST/namrun/ ln_rstdate, cn_rst_dir  
    149  
    150148#if defined key_netcdf4 
    151149      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 
    … …  
    172170         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in 
    173171         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out 
    174          WRITE(numout,*) '      restart directory               cn_rst_dir = ', cn_rst_dir 
    175172         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart 
    176173         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler 
    … …  
    182179         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate 
    183180         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock 
    184          WRITE(numout,*) '      use date in restart name        ln_rstdate = ', ln_rstdate 
    185181         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write 
    186182         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn 

  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5389 r5417  
    102102      INTEGER ::   ios 
    103103      ! 
    104       NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_read_zenv 
     104      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 
    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 
    128127      ENDIF 
    129128 
    … …  
    541540               CALL iom_get  ( inum, jpdom_data, 'Bathymetry'    , bathy, lrowattr=ln_use_jattr  ) 
    542541            END IF 
    543             IF ( ln_read_zenv ) THEN                  ! Whether we should read zenv or not  
    544                CALL iom_get  ( inum, jpdom_data, 'zenv', zenv ) 
    545             ENDIF 
    546542            CALL iom_close( inum ) 
    547543            !                                                 
    … …  
    18221818      ! 
    18231819      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 
    1824       REAL(wp), POINTER, DIMENSION(:,:  ) :: ztmp, zmsk, zri, zrj, zhbat 
     1820      REAL(wp), POINTER, DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat 
    18251821 
    18261822      NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & 
    … …  
    18301826      IF( nn_timing == 1 )  CALL timing_start('zgr_sco') 
    18311827      ! 
    1832       CALL wrk_alloc( jpi, jpj, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 
     1828      CALL wrk_alloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 
    18331829      ! 
    18341830      REWIND( numnam_ref )              ! Namelist namzgr_sco in reference namelist : Sigma-stretching parameters 
    … …  
    18841880      !                                        ! ============================= 
    18851881      ! use r-value to create hybrid coordinates 
    1886       scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea) 
    1887       scobot(:,:) = bathy(:,:)        ! ocean bottom  depth 
    1888       IF( ln_read_zenv) THEN 
    1889            WRITE(numout,*) '      Zenv is not calculated but read from Bathy File ln_read_zenv        = ', ln_read_zenv 
    1890       ELSE 
    18911882      zenv(:,:) = bathy(:,:) 
    18921883      ! 
    … …  
    19101901      !  
    19111902      ! smooth the bathymetry (if required) 
     1903      scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea) 
     1904      scobot(:,:) = bathy(:,:)        ! ocean bottom  depth 
    19121905      ! 
    19131906      jl = 0 
    … …  
    19731966      END DO                                                !     End loop     ! 
    19741967      !                                                     ! ================ ! 
    1975  
    1976       ENDIF ! End of IF Block for reading in zenv 
    1977       CALL lbc_lnk( zenv, 'T', 1._wp, 'no0' ) 
    19781968      DO jj = 1, jpj 
    19791969         DO ji = 1, jpi 
    … …  
    22512241      END DO 
    22522242      ! 
    2253       CALL wrk_dealloc( jpi, jpj, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 
     2243      CALL wrk_dealloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 
    22542244      ! 
    22552245      IF( nn_timing == 1 )  CALL timing_stop('zgr_sco') 

  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r5389 r5417  
    2727   CHARACTER(lc) ::   cn_ocerst_in     !: suffix of ocean restart name (input) 
    2828   CHARACTER(lc) ::   cn_ocerst_out    !: suffix of ocean restart name (output) 
    29    CHARACTER(lc) ::   cn_rst_dir = "./"!: restart directory 
    3029   LOGICAL       ::   ln_rstart        !: start from (F) rest or (T) a restart file 
    31    LOGICAL       ::   ln_rstdate       !: Use calendar date rather than time-step in restart names 
    3230   INTEGER       ::   nn_no            !: job number 
    3331   INTEGER       ::   nn_rstctl        !: control of the time step (0, 1 or 2) 

  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r5389 r5417  
    5555      !!---------------------------------------------------------------------- 
    5656      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    57       INTEGER             ::   iyear, imonth, iday 
    58       REAL (wp)           ::   zsec 
    5957      !! 
    6058      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    6159      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
    62       CHARACTER(len=150)  ::   clpath   ! full path to ocean output restart file 
    6360      !!---------------------------------------------------------------------- 
    6461      ! 
    … …  
    7774      IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 
    7875         ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    79          IF ( ln_rstdate ) THEN 
    80             CALL ju2ymds( fjulday + rdttra(1) / rday, iyear, imonth, iday, zsec) 
    81             WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 
    82          ELSE 
    83             IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    84             ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst 
    85             ENDIF 
     76         IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
     77         ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst 
    8678         ENDIF 
    8779         ! create the file 
    8880         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out) 
    89          clpath = TRIM(cn_rst_dir) 
    90          IF( clpath(LEN_TRIM(clpath):) /= '/' ) THEN 
    91            clpath = TRIM(clpath) // '/' 
    92          ENDIF 
    9381         IF(lwp) THEN 
    9482            WRITE(numout,*) 
    9583            SELECT CASE ( jprstlib ) 
    96             CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ocean restart binary file: ',TRIM(clpath)//clname 
    97             CASE DEFAULT         ;   WRITE(numout,*) '             open ocean restart NetCDF file: ',TRIM(clpath)//clname 
     84            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ocean restart binary file: '//clname 
     85            CASE DEFAULT         ;   WRITE(numout,*) '             open ocean restart NetCDF file: '//clname 
    9886            END SELECT 
    9987            IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression' 
    … …  
    10391         ENDIF 
    10492         ! 
    105          CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib ) 
     93         CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib ) 
    10694         lrst_oce = .TRUE. 
    10795      ENDIF 

  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r5389 r5417  
    108108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s] 
    109109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1) 
    110    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pressnow          !: UKMO SHELF pressure 
    111    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   apgu              !: UKMO SHELF pressure forcing 
    112    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   apgv              !: UKMO SHELF pressure forcing 
    113110#if defined key_cpl_carbon_cycle 
    114111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm] 
    … …  
    155152         ! 
    156153      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     & 
    157          &      pressnow(jpi,jpj), apgu(jpi,jpj)    , apgv(jpi,jpj) ,     & 
    158154#if defined key_cpl_carbon_cycle 
    159155         &      atm_co2(jpi,jpj) ,                                        & 

  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r5389 r5417  
    2828   PUBLIC sbc_flx       ! routine called by step.F90 
    2929 
    30    INTEGER , PARAMETER ::   jpfld   = 6   ! maximum number of files to read  
     30   INTEGER , PARAMETER ::   jpfld   = 5   ! 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 
    3736   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 read (locally modified depending on ln_shelf_flx)  
    4037 
    4138   !! * Substitutions 
    … …  
    8582      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient 
    8683      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables 
    87       REAL     ::   cs                    ! UKMO SHELF: Friction co-efficient at surface 
    88       REAL     ::   totwindspd            ! UKMO SHELF: Magnitude of wind speed vector 
    89     
    90       REAL(wp) ::   rhoa  = 1.22         ! Air density kg/m3 
    91       REAL(wp) ::   cdrag = 1.5e-3       ! drag coefficient  
    9284      !! 
    9385      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files 
    9486      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures 
    95       TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, sn_press  !  informations about the fields to be read 
    96       LOGICAL     ::   ln_foam_flx  = .FALSE.                     ! UKMO FOAM specific flux flag 
    97       NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp,   & 
    98       &                    ln_foam_flx, sn_press, ln_shelf_flx 
     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 
    9989      !!--------------------------------------------------------------------- 
    10090      ! 
    … …  
    119109         slf_i(jp_emp ) = sn_emp 
    120110         ! 
    121          IF( ln_shelf_flx ) slf_i(jp_press) = sn_press 
    122  
    123          ! define local jpfld depending on shelf_flx logical 
    124          IF( ln_shelf_flx ) THEN 
    125             jpfld_local = jpfld 
    126          ELSE 
    127             jpfld_local = jpfld-1 
    128          ENDIF 
    129          ! 
    130          ALLOCATE( sf(jpfld_local), STAT=ierror )        ! set sf structure 
     111         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
    131112         IF( ierror > 0 ) THEN    
    132113            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN   
    … …  
    151132         ENDIF 
    152133!CDIR COLLAPSE 
    153             !!UKMO SHELF effect of atmospheric pressure on SSH 
    154             ! If using ln_apr_dyn, this is done there so don't repeat here. 
    155             IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN 
    156                DO jj = 1, jpjm1 
    157                   DO ji = 1, jpim1 
    158                      apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj) 
    159                      apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj) 
    160                   END DO 
    161                END DO 
    162             ENDIF ! ln_shelf_flx 
    163134         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields 
    164135            DO ji = 1, jpi 
    165                 IF( ln_shelf_flx ) THEN 
    166                    !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing 
    167                    pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1) 
    168                    !! UKMO SHELF flux files contain wind speed not wind stress 
    169                    totwindspd = sqrt((sf(jp_utau)%fnow(ji,jj,1))**2.0 + (sf(jp_vtau)%fnow(ji,jj,1))**2.0) 
    170                    cs = 0.63 + (0.066 * totwindspd) 
    171                    utau(ji,jj) = cs * (rhoa/rau0) * sf(jp_utau)%fnow(ji,jj,1) * totwindspd 
    172                    vtau(ji,jj) = cs * (rhoa/rau0) * sf(jp_vtau)%fnow(ji,jj,1) * totwindspd 
    173                 ELSE 
    174                    utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
    175                    vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
    176                 ENDIF 
    177                 qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 
    178                 IF( ln_foam_flx .OR. ln_shelf_flx ) THEN 
    179                    !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 
    180                    qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 
    181                    !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 
    182                    emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 
    183                 ELSE 
    184                    qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
    185                    emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
    186                 ENDIF 
     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) 
    187140            END DO 
    188141         END DO 
    … …  
    190143         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
    191144         ! 
    192  
    193          !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe 
    194          IF( ln_foam_flx ) THEN 
    195             CALL lbc_lnk( utau(:,:), 'U', -1. ) 
    196             CALL lbc_lnk( vtau(:,:), 'V', -1. ) 
    197          ENDIF 
    198      
    199145         !                                                        ! module of wind stress and wind speed at T-point 
    200146         zcoef = 1. / ( zrhoa * zcdrag ) 
    … …  
    216162            WRITE(numout,*)  
    217163            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK' 
    218             DO jf = 1, jpfld_local 
     164            DO jf = 1, jpfld 
    219165               IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1. 
    220166               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1 

  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r5389 r5417  
    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 
    4544 
    4645   REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange 
    … …  
    8079      INTEGER  ::   ierror   ! return error code 
    8180      !! 
    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       !! 
    9081      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
    9182      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
    … …  
    10495            ! 
    10596            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
    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 
     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 
    134104               CALL iom_put( "qrp", qrp )                             ! heat flux damping 
    135105            ENDIF 
    … …  
    193163      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
    194164      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
    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 
     165      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 
    196166      INTEGER     ::  ios 
    197167      !!---------------------------------------------------------------------- 
    … …  
    219189         WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd 
    220190         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 
    222191      ENDIF 
    223192      ! 

  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r5389 r5417  
    2424   USE trd_oce         ! trends: ocean variables 
    2525   USE trdtra          ! trends manager: tracers  
    26    USE tradwl          ! solar radiation penetration (downwell method) 
    2726   ! 
    2827   USE in_out_manager  ! I/O manager 
    … …  
    142141 
    143142!!gm      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration 
    144       IF( .NOT.ln_traqsr .and. .NOT.ln_tradwl ) THEN     ! no solar radiation penetration 
     143      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration 
    145144         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns 
    146145         qsr(:,:) = 0.e0                     ! qsr set to zero 

  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5389 r5417  
    100100      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    101101      IF( lk_tide    )   CALL sbc_tide( kstp ) 
     102      IF( lk_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
    102103 
    103104                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    104105                                                      ! clem: moved here for bdy ice purpose 
    105           IF ( ln_shelf_flx .AND. & 
    106               & .NOT. ln_apr_dyn) CALL inv( kstp )             !  modification to vel from atmos pres  
    107       IF( lk_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
    108106 
    109107      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    245243                             CALL tra_sbc    ( kstp )       ! surface boundary condition 
    246244      IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr 
    247       IF( ln_tradwl      )   CALL tra_dwl    ( kstp )       ! Polcoms Style Short Wave Radiation  
    248245      IF( ln_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux 
    249246      IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme 

  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r5389 r5417  
    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 
    2827   USE sbc_oce          ! surface boundary condition: ocean 
    2928   USE sbctide          ! Tide initialisation 
    3029 
    3130   USE traqsr           ! solar radiation penetration      (tra_qsr routine) 
    32    USE tradwl           ! POLCOMS style solar radiation    (tra_dwl routine)   
    3331   USE trasbc           ! surface boundary condition       (tra_sbc routine) 
    3432   USE trabbc           ! bottom boundary condition        (tra_bbc routine) 
    … …  
    6361 
    6462   USE sshwzv           ! vertical velocity and ssh        (ssh_nxt routine) 
    65    USE inv_bar_vel_mod  ! Atmos press effect on vel  
    6663   !                                                       (ssh_swp routine) 
    6764   !                                                       (wzv     routine) 

  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r5389 r5417  
    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  
    3129 
    3230#if defined key_top  
    … …  
    7876      !!                  ***  trc_oce_alloc  *** 
    7977      !!---------------------------------------------------------------------- 
    80       INTEGER ::   ierr(3)        ! Local variables 
     78      INTEGER ::   ierr(2)        ! Local variables 
    8179      !!---------------------------------------------------------------------- 
    8280      ierr(:) = 0 
    8381                     ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) ) 
    8482      IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) ) 
    85                      ALLOCATE( rlambda2(jpi,jpj),   STAT=ierr(3) ) 
    8683      trc_oce_alloc  = MAXVAL( ierr ) 
    8784      ! 
    88       IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3, facvol or rlambda2 array') 
     85      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array') 
    8986   END FUNCTION trc_oce_alloc 
    9087 
Note: See TracChangeset for help on using the changeset viewer.