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.
sbcice_if.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 5 years ago

The Dr Hook changes from my perl code.

File size: 7.9 KB
Line 
1MODULE sbcice_if
2   !!======================================================================
3   !!                       ***  MODULE  sbcice  ***
4   !! Surface module :  update surface ocean boundary condition over ice
5   !!                   covered area using ice-if model
6   !!======================================================================
7   !! History :  3.0  !  2006-06  (G. Madec)  Original code
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   sbc_ice_if    : update sbc in ice-covered area
12   !!----------------------------------------------------------------------
13   USE oce            ! ocean dynamics and tracers
14   USE dom_oce        ! ocean space and time domain
15   USE phycst         ! physical constants
16   USE eosbn2         ! equation of state
17   USE sbc_oce        ! surface boundary condition: ocean fields
18#if defined key_lim3
19   USE ice    , ONLY :   a_i 
20#else
21   USE sbc_ice, ONLY :   a_i 
22#endif
23   USE fldread        ! read input field
24   USE iom            ! I/O manager library
25   USE in_out_manager ! I/O manager
26   USE lib_mpp        ! MPP library
27   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
28
29   USE yomhook, ONLY: lhook, dr_hook
30   USE parkind1, ONLY: jprb, jpim
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC   sbc_ice_if      ! routine called in sbcmod
36
37   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ice   ! structure of input ice-cover (file informations, fields read)
38   
39   !! * Substitutions
40#  include "domzgr_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
43   !! $Id$
44   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
45   !!----------------------------------------------------------------------
46CONTAINS
47
48   SUBROUTINE sbc_ice_if( kt )
49      !!---------------------------------------------------------------------
50      !!                     ***  ROUTINE sbc_ice_if  ***
51      !!
52      !! ** Purpose :   handle surface boundary condition over ice cover area
53      !!      when sea-ice model are not used
54      !!
55      !! ** Method  : - read sea-ice cover climatology
56      !!              - blah blah blah, ...
57      !!
58      !! ** Action  :   utau, vtau : remain unchanged
59      !!                taum, wndm : remain unchanged
60      !!                qns, qsr   : update heat flux below sea-ice
61      !!                emp, sfx   : update freshwater flux below sea-ice
62      !!                fr_i       : update the ice fraction
63      !!---------------------------------------------------------------------
64      INTEGER, INTENT(in) ::   kt   ! ocean time step
65      !
66      INTEGER  ::   ji, jj     ! dummy loop indices
67      INTEGER  ::   ierror     ! return error code
68      INTEGER  ::   ios        ! Local integer output status for namelist read
69      REAL(wp) ::   ztrp, zsice, zt_fzp, zfr_obs
70      REAL(wp) ::   zqri, zqrj, zqrp, zqi
71      !!
72      CHARACTER(len=100) ::   cn_dir              ! Root directory for location of ice-if files
73      TYPE(FLD_N)        ::   sn_ice              ! informations about the fields to be read
74      NAMELIST/namsbc_iif/ cn_dir, sn_ice
75      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
76      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
77      REAL(KIND=jprb)               :: zhook_handle
78
79      CHARACTER(LEN=*), PARAMETER :: RoutineName='SBC_ICE_IF'
80
81      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
82
83      !!---------------------------------------------------------------------
84      !                                         ! ====================== !
85      IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
86         !                                      ! ====================== !
87         ! set file information
88         REWIND( numnam_ref )              ! Namelist namsbc_iif in reference namelist : Ice if file
89         READ  ( numnam_ref, namsbc_iif, IOSTAT = ios, ERR = 901)
90901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iif in reference namelist', lwp )
91
92         REWIND( numnam_cfg )              ! Namelist Namelist namsbc_iif in configuration namelist : Ice if file
93         READ  ( numnam_cfg, namsbc_iif, IOSTAT = ios, ERR = 902 )
94902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iif in configuration namelist', lwp )
95         IF(lwm) WRITE ( numond, namsbc_iif )
96
97         ALLOCATE( sf_ice(1), STAT=ierror )
98         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_if: unable to allocate sf_ice structure' )
99         ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1) )
100         IF( sn_ice%ln_tint )   ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) )
101
102         ! fill sf_ice with sn_ice and control print
103         CALL fld_fill( sf_ice, (/ sn_ice /), cn_dir, 'sbc_ice_if', 'ice-if sea-ice model', 'namsbc_iif' )
104         !
105      ENDIF
106
107      CALL fld_read( kt, nn_fsbc, sf_ice )           ! Read input fields and provides the
108      !                                              ! input fields at the current time-step
109     
110      IF( MOD( kt-1, nn_fsbc) == 0 ) THEN
111         !
112         ztrp = -40.             ! restoring terme for temperature (w/m2/k)
113         zsice = - 0.04 / 0.8    ! ratio of isohaline compressibility over isotherme compressibility
114                                 ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 )
115         
116         CALL eos_fzp( sss_m(:,:), fr_i(:,:) )       ! sea surface freezing temperature [Celcius]
117         fr_i(:,:) = fr_i(:,:) * tmask(:,:,1)
118
119         IF( ln_cpl )   a_i(:,:,1) = fr_i(:,:)         
120
121         ! Flux and ice fraction computation
122         DO jj = 1, jpj
123            DO ji = 1, jpi
124               !
125               zt_fzp  = fr_i(ji,jj)                        ! freezing point temperature
126               zfr_obs = sf_ice(1)%fnow(ji,jj,1)            ! observed ice cover
127               !                                            ! ocean ice fraction (0/1) from the freezing point temperature
128               IF( sst_m(ji,jj) <= zt_fzp ) THEN   ;   fr_i(ji,jj) = 1.e0
129               ELSE                                ;   fr_i(ji,jj) = 0.e0
130               ENDIF
131
132               tsn(ji,jj,1,jp_tem) = MAX( tsn(ji,jj,1,jp_tem), zt_fzp )     ! avoid over-freezing point temperature
133
134               qsr(ji,jj) = ( 1. - zfr_obs ) * qsr(ji,jj)   ! solar heat flux : zero below observed ice cover
135
136               !                                            ! non solar heat flux : add a damping term
137               !      # ztrp*(t-(tgel-1.))  if observed ice and no opa ice   (zfr_obs=1 fr_i=0)
138               !      # ztrp*min(0,t-tgel)  if observed ice and opa ice      (zfr_obs=1 fr_i=1)
139               zqri = ztrp * ( tsb(ji,jj,1,jp_tem) - ( zt_fzp - 1.) )
140               zqrj = ztrp * MIN( 0., tsb(ji,jj,1,jp_tem) - zt_fzp )
141               zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri    &
142                 &                 +      fr_i(ji,jj)   * zqrj ) ) * tmask(ji,jj,1)
143
144               !                                            ! non-solar heat flux
145               !      # qns unchanged              if no climatological ice              (zfr_obs=0)
146               !      # qns = zqrp                 if climatological ice and no opa ice  (zfr_obs=1, fr_i=0)
147               !      # qns = zqrp -2(-4) watt/m2  if climatological ice and opa ice     (zfr_obs=1, fr_i=1)
148               !                                   (-2=arctic, -4=antarctic)   
149               zqi = -3. + SIGN( 1.e0, ff(ji,jj) )
150               qns(ji,jj) = ( ( 1.- zfr_obs ) * qns(ji,jj)                             &
151                  &          +      zfr_obs   * fr_i(ji,jj) * zqi ) * tmask(ji,jj,1)   &
152                  &       + zqrp
153            END DO
154         END DO
155         !
156      ENDIF
157      !
158      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
159   END SUBROUTINE sbc_ice_if
160
161   !!======================================================================
162END MODULE sbcice_if
Note: See TracBrowser for help on using the repository browser.