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.
isfdiags.F90 in NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF – NEMO

source: NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfdiags.F90 @ 11987

Last change on this file since 11987 was 11987, checked in by mathiot, 4 years ago

ENHANCE-02_ISF_nemo: changes needed after Dave's review
File size: 5.6 KB
Line 
1MODULE isfdiags
2   !!======================================================================
3   !!                       ***  MODULE  sbcisf  ***
4   !! Surface module :  update surface ocean boundary condition under ice
5   !!                   shelf
6   !!======================================================================
7   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav
8   !!            X.X  !  2006-02  (C. Wang   ) Original code bg03
9   !!            3.4  !  2013-03  (P. Mathiot) Merging + parametrization
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   sbc_isf       : update sbc under ice shelf
14   !!----------------------------------------------------------------------
15
16   USE in_out_manager ! I/O manager
17   USE dom_oce
18   USE isf_oce        ! ice shelf variable
19   USE iom            !
20
21   IMPLICIT NONE
22
23   PRIVATE
24
25   PUBLIC   isf_diags_flx
26
27   !!----------------------------------------------------------------------
28   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
29   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
30   !! Software governed by the CeCILL license (see ./LICENSE)
31   !!----------------------------------------------------------------------
32
33CONTAINS
34
35   SUBROUTINE isf_diags_flx(ktop, kbot, phtbl, pfrac, cdisf, pqfwf, pqoce, pqlat, pqhc)
36      !!---------------------------------------------------------------------
37      !!                  ***  ROUTINE isf_diags_2dto3d ***
38      !!
39      !! ** Purpose :
40      !!
41      !!----------------------------------------------------------------------
42      !!-------------------------- OUT -------------------------------------
43      !!-------------------------- IN  -------------------------------------
44      INTEGER , DIMENSION(jpi,jpj), INTENT(in) :: ktop , kbot               ! top and bottom level of the tbl
45      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac              ! thickness of the tbl and fraction of last cell affected by the tbl
46      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqfwf, pqoce, pqlat, pqhc ! 2d var to map in 3d
47      CHARACTER(LEN=3), INTENT(in) :: cdisf                                 ! parametrisation or interactive melt
48      !!---------------------------------------------------------------------
49      CHARACTER(LEN=256) :: cvarqfwf  , cvarqoce  , cvarqlat  , cvarqhc
50      CHARACTER(LEN=256) :: cvarqfwf3d, cvarqoce3d, cvarqlat3d, cvarqhc3d
51      !!---------------------------------------------------------------------
52      !
53      ! output melt
54      cvarqfwf = 'fwfisf_'//cdisf  ; cvarqfwf3d = 'fwfisf3d_'//cdisf
55      cvarqoce = 'qoceisf_'//cdisf ; cvarqoce3d = 'qoceisf3d_'//cdisf
56      cvarqlat = 'qlatisf_'//cdisf ; cvarqlat3d = 'qlatisf3d_'//cdisf 
57      cvarqhc  = 'qhcisf_'//cdisf  ; cvarqhc3d  = 'qhcisf3d_'//cdisf
58      !
59      ! output 2d melt rate, latent heat and heat content flux
60      CALL iom_put( TRIM(cvarqfwf), pqfwf(:,:) )   ! isf mass flux (opposite sign)
61      CALL iom_put( TRIM(cvarqoce), pqoce(:,:) )   ! isf oce to ice   flux  (cpo*gt*dt)
62      CALL iom_put( TRIM(cvarqlat), pqlat(:,:) )   ! isf oce to ice   flux  (cpo*gt*dt)
63      CALL iom_put( TRIM(cvarqhc) , pqhc (:,:) )   ! isf heat content flux  (cpo*fwf*Tfrz)
64      !
65      ! output 3d Diagnostics
66      IF ( iom_use( TRIM(cvarqfwf3d) ) ) CALL isf_diags_2dto3d( ktop, kbot, phtbl, pfrac, TRIM(cvarqfwf3d) , pqfwf(:,:))
67      IF ( iom_use( TRIM(cvarqoce3d) ) ) CALL isf_diags_2dto3d( ktop, kbot, phtbl, pfrac, TRIM(cvarqoce3d) , pqoce(:,:))
68      IF ( iom_use( TRIM(cvarqlat3d) ) ) CALL isf_diags_2dto3d( ktop, kbot, phtbl, pfrac, TRIM(cvarqlat3d) , pqoce(:,:))
69      IF ( iom_use( TRIM(cvarqhc3d)  ) ) CALL isf_diags_2dto3d( ktop, kbot, phtbl, pfrac, TRIM(cvarqhc3d)  , pqhc (:,:))
70      !
71   END SUBROUTINE
72
73   SUBROUTINE isf_diags_2dto3d(ktop, kbot, phtbl, pfrac, cdvar, pvar2d)
74      !!---------------------------------------------------------------------
75      !!                  ***  ROUTINE isf_diags_2dto3d ***
76      !!
77      !! ** Purpose :
78      !!
79      !!----------------------------------------------------------------------
80      !!-------------------------- OUT -------------------------------------
81      !!-------------------------- IN  -------------------------------------
82      INTEGER , DIMENSION(jpi,jpj), INTENT(in) :: ktop , kbot   ! top and bottom level of the tbl
83      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac  ! thickness of the tbl and fraction of last cell affected by the tbl
84      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pvar2d        ! 2d var to map in 3d
85      CHARACTER(LEN=256), INTENT(in) :: cdvar
86      !!---------------------------------------------------------------------
87      INTEGER  :: ji, jj, jk                       ! loop indices
88      INTEGER  :: ikt, ikb                         ! top and bottom level of the tbl
89      REAL(wp), DIMENSION(jpi,jpj)     :: zvar2d   !
90      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvar3d   ! 3d var to output
91      !!---------------------------------------------------------------------
92      !
93      ! compute 3d output
94      zvar2d(:,:) = pvar2d(:,:) / phtbl(:,:)
95      zvar3d(:,:,:) = 0._wp
96      !
97      DO jj = 1,jpj
98         DO ji = 1,jpi
99            ikt = ktop(ji,jj)
100            ikb = kbot(ji,jj)
101            DO jk = ikt, ikb - 1
102               zvar3d(ji,jj,jk) = zvar2d(ji,jj) * e3t_n(ji,jj,jk)
103            END DO
104            zvar3d(ji,jj,ikb) = zvar2d(ji,jj) * e3t_n(ji,jj,ikb) * pfrac(ji,jj)
105         END DO
106      END DO
107      !
108      CALL iom_put( TRIM(cdvar) , zvar3d(:,:,:))
109      !
110   END SUBROUTINE isf_diags_2dto3d
111
112END MODULE isfdiags
Note: See TracBrowser for help on using the repository browser.