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/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED – NEMO

source: NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedwri.F90 @ 10345

Last change on this file since 10345 was 10345, checked in by smasson, 5 years ago

dev_r10164_HPC09_ESIWACE_PREP_MERGE: merge with trunk@10344, see #2133

  • Property svn:keywords set to Id
File size: 4.4 KB
RevLine 
[3443]1MODULE sedwri
2   !!======================================================================
3   !!                     ***  MODULE  sedwri  ***
4   !!         Sediment diagnostics :  write sediment output files
5   !!======================================================================
6   USE sed
7   USE sedarr
[10345]8   USE lib_mpp         ! distribued memory computing library
9   USE iom
[3443]10
11   IMPLICIT NONE
12   PRIVATE
13
14   !! * Accessibility
15   PUBLIC sed_wri 
16
[5215]17   !! $Id$
[3443]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
[10345]35      INTEGER  :: ji, jj, jk, js, jw, jn
36      INTEGER  :: it
37      CHARACTER(len = 20)  ::  cltra 
[3443]38      REAL(wp)  :: zrate
39      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta, zflx
40
41      !!-------------------------------------------------------------------
42
43
44      ! Initialisation
45      ! -----------------
46
47      ! 1.  Initilisations
48      ! -----------------------------------------------------------------
[10345]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,*) ' '
[3443]54     
55      ALLOCATE( zdta(jpoce,jpksed) )    ;   ALLOCATE( zflx(jpoce,jpwatp1) )
56
[10345]57      ! Initialize variables
58      ! --------------------
[3443]59
[10345]60      trcsedi(:,:,:,:)   = 0.0
61      flxsedi3d(:,:,:,:) = 0.0
62      flxsedi2d(:,:,:)   = 0.0
63
[3443]64      ! 2.  Back to 2D geometry
65      ! -----------------------------------------------------------------
[10345]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
[3443]70     
[10345]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
[3443]76      ! porosity
77      zdta(:,:) = 0.
78      DO jk = 1, jpksed
79         DO ji = 1, jpoce
[10345]80            zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn )
[3443]81         ENDDO
82      ENDDO
[10345]83
[3443]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     
[10345]90!      flxsedi3d = 0.
[3443]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) ) &
[10345]96               &         * 1.e3 / 1.e2 * dzkbot(ji) / r2dttrc
[3443]97         ENDDO
98      ENDDO
[10345]99
[3443]100      ! Calculation of accumulation rate per dt
101      DO js = 1, jpsol
[10345]102         zrate =  1.0 / ( denssol * por1(jpksed) ) / r2dttrc
[3443]103         DO ji = 1, jpoce
104            zflx(ji,jpwatp1) = zflx(ji,jpwatp1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate
105         ENDDO
106      ENDDO
107
[10345]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) )
[3443]113
114       ! Start writing data
115       ! ---------------------
116       DO jn = 1, jptrased
117          cltra = sedtrcd(jn) ! short title for 3D diagnostic
[10345]118          CALL iom_put( cltra, trcsedi(:,:,:,jn) )
[3443]119       END DO
120
121       DO jn = 1, jpdia3dsed
122          cltra = seddia3d(jn) ! short title for 3D diagnostic
[10345]123          CALL iom_put( cltra, flxsedi3d(:,:,:,jn) )
[3443]124       END DO
125
126       DO jn = 1, jpdia2dsed
[10345]127          cltra = seddia2d(jn) ! short title for 2D diagnostic
128          CALL iom_put( cltra, flxsedi2d(:,:,jn) )
[3443]129       END DO
130
131
132      DEALLOCATE( zdta )    ;   DEALLOCATE( zflx )
133
[10345]134      IF( ln_timing )  CALL timing_stop('sed_wri')
[3443]135
136   END SUBROUTINE sed_wri
137
138END MODULE sedwri
Note: See TracBrowser for help on using the repository browser.