source: NEMO/trunk/src/TOP/PISCES/SED/sedwri.F90 @ 14086

Last change on this file since 14086 was 14086, checked in by cetlod, 3 months ago

Adding AGRIF branches into the trunk

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