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.
sedwri.F90 in NEMO/branches/UKMO/NEMO_4.0.2_ENHANCE-02_ISF_nemo/src/TOP/PISCES/SED – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.2_ENHANCE-02_ISF_nemo/src/TOP/PISCES/SED/sedwri.F90 @ 12709

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

NEMO_4.0.2_ENHANCE-02_ISF_nemo: remove svn keywords

File size: 4.4 KB
Line 
1MODULE sedwri
2   !!======================================================================
3   !!                     ***  MODULE  sedwri  ***
4   !!         Sediment diagnostics :  write sediment output files
5   !!======================================================================
6   USE sed
7   USE sedarr
8   USE lib_mpp         ! distribued memory computing library
9   USE iom
10
11   IMPLICIT NONE
12   PRIVATE
13
14   !! * Accessibility
15   PUBLIC sed_wri 
16
17   !! $Id$
18CONTAINS
19
20   !!----------------------------------------------------------------------
21   !!                                                   NetCDF output file
22   !!----------------------------------------------------------------------
23   SUBROUTINE sed_wri( kt )
24      !!----------------------------------------------------------------------
25      !!                   ***  ROUTINE sed_wri  ***
26      !!
27      !! ** Purpose :  output of sediment passive tracer
28      !!
29      !!   History :
30      !!        !  06-07  (C. Ethe)  original
31      !!----------------------------------------------------------------------
32
33      INTEGER, INTENT(in) :: kt
34
35      INTEGER  :: ji, jj, jk, js, jw, jn
36      INTEGER  :: it
37      CHARACTER(len = 20)  ::  cltra 
38      REAL(wp)  :: zrate
39      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta, zflx
40
41      !!-------------------------------------------------------------------
42
43
44      ! Initialisation
45      ! -----------------
46
47      ! 1.  Initilisations
48      ! -----------------------------------------------------------------
49      IF( ln_timing )  CALL timing_start('sed_wri')
50!
51      IF (lwp) WRITE(numsed,*) ' '
52      IF (lwp) WRITE(numsed,*) 'sed_wri kt = ', kt
53      IF (lwp) WRITE(numsed,*) ' '
54     
55      ALLOCATE( zdta(jpoce,jpksed) )    ;   ALLOCATE( zflx(jpoce,jpwatp1) )
56
57      ! Initialize variables
58      ! --------------------
59
60      trcsedi(:,:,:,:)   = 0.0
61      flxsedi3d(:,:,:,:) = 0.0
62      flxsedi2d(:,:,:)   = 0.0
63
64      ! 2.  Back to 2D geometry
65      ! -----------------------------------------------------------------
66      DO jn = 1, jpsol
67         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), &
68         &                       solcp(1:jpoce,1:jpksed,jn ) )
69      END DO
70     
71      DO jn = 1, jpwat
72         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol + jn) , iarroce(1:jpoce), &
73         &                       pwcp(1:jpoce,1:jpksed,jn  )  )
74      END DO     
75
76      ! porosity
77      zdta(:,:) = 0.
78      DO jk = 1, jpksed
79         DO ji = 1, jpoce
80            zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn )
81         ENDDO
82      ENDDO
83
84      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), &
85         &                   zdta(1:jpoce,1:jpksed)  )
86     
87      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), &
88         &                   co3por(1:jpoce,1:jpksed)  )
89     
90!      flxsedi3d = 0.
91      zflx(:,:) = 0.   
92      ! Calculation of fluxes mol/cm2/s
93      DO jw = 1, jpwat
94         DO ji = 1, jpoce
95            zflx(ji,jw) = ( pwcp(ji,1,jw) - pwcp_dta(ji,jw) ) &
96               &         * 1.e3 / 1.e2 * dzkbot(ji) / r2dttrc
97         ENDDO
98      ENDDO
99
100      ! Calculation of accumulation rate per dt
101      DO js = 1, jpsol
102         zrate =  1.0 / ( denssol * por1(jpksed) ) / r2dttrc
103         DO ji = 1, jpoce
104            zflx(ji,jpwatp1) = zflx(ji,jpwatp1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate
105         ENDDO
106      ENDDO
107
108      DO jn = 1, jpdia2dsed - 1 
109         CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,jn), iarroce(1:jpoce), zflx(1:jpoce,jn)  )
110      END DO
111      zflx(:,1) = dzdep(:) / dtsed
112      CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,jpdia2dsed), iarroce(1:jpoce), zflx(1:jpoce,1) )
113
114       ! Start writing data
115       ! ---------------------
116       DO jn = 1, jptrased
117          cltra = sedtrcd(jn) ! short title for 3D diagnostic
118          CALL iom_put( cltra, trcsedi(:,:,:,jn) )
119       END DO
120
121       DO jn = 1, jpdia3dsed
122          cltra = seddia3d(jn) ! short title for 3D diagnostic
123          CALL iom_put( cltra, flxsedi3d(:,:,:,jn) )
124       END DO
125
126       DO jn = 1, jpdia2dsed
127          cltra = seddia2d(jn) ! short title for 2D diagnostic
128          CALL iom_put( cltra, flxsedi2d(:,:,jn) )
129       END DO
130
131
132      DEALLOCATE( zdta )    ;   DEALLOCATE( zflx )
133
134      IF( ln_timing )  CALL timing_stop('sed_wri')
135
136   END SUBROUTINE sed_wri
137
138END MODULE sedwri
Note: See TracBrowser for help on using the repository browser.