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