source: LMDZ6/trunk/libf/phylmd/limit_slab.F90 @ 5171

Last change on this file since 5171 was 5084, checked in by Laurent Fairhead, 12 months ago

Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks
AB, LF
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.7 KB
Line 
1! $Header$
2
3SUBROUTINE limit_slab(itime, dtime, jour, lmt_bils, diff_sst, diff_siv)
4
5  USE dimphy
6  USE mod_grid_phy_lmdz, ONLY: klon_glo
7  USE mod_phys_lmdz_para
8  USE netcdf
9  USE indice_sol_mod
10  USE ocean_slab_mod, ONLY: nslay
11
12  IMPLICIT NONE
13
14  INCLUDE "clesphys.h"
15
16! In- and ouput arguments
17!****************************************************************************************
18  INTEGER, INTENT(IN) :: itime   ! numero du pas de temps courant
19  INTEGER, INTENT(IN) :: jour    ! jour a lire dans l'annee
20  REAL   , INTENT(IN) :: dtime   ! pas de temps de la physique (en s)
21  REAL, DIMENSION(klon), INTENT(OUT) ::  diff_sst, diff_siv
22  REAL, DIMENSION(klon,nslay), INTENT(OUT) :: lmt_bils
23
24! Locals variables with attribute SAVE
25!****************************************************************************************
26  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diff_siv_save, diff_sst_save
27  REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: bils_save
28!$OMP THREADPRIVATE(bils_save, diff_sst_save, diff_siv_save)
29
30! Locals variables
31!****************************************************************************************
32  INTEGER                  :: lmt_pas   
33  INTEGER                  :: nvarid, nid, ierr, i
34  INTEGER, DIMENSION(2)    :: start, epais
35  REAL, DIMENSION(klon_glo):: sst_l_glo, sst_lp1_glo, diff_sst_glo
36  REAL, DIMENSION(klon_glo):: siv_l_glo, siv_lp1_glo, diff_siv_glo
37  REAL, DIMENSION(klon_glo,nslay):: bils_glo
38  CHARACTER (len = 20)     :: modname = 'limit_slab'
39  CHARACTER*2 str2
40  LOGICAL                  :: read_bils,read_sst,read_siv
41
42! End declaration
43!****************************************************************************************
44
45  ! calculate number of time steps for one day
46  lmt_pas = NINT(86400./dtime)
47 
48! Initialize saved variables
49     IF (.NOT. ALLOCATED(bils_save)) THEN
50        ALLOCATE(bils_save(klon,nslay), diff_sst_save(klon), diff_siv_save(klon), stat=ierr)
51        IF (ierr /= 0) CALL abort_physic('limit_slab', 'pb in allocation',1)
52     END IF
53
54  ! F. Codron 5/14: add defaults for bils, diff_sst (0)
55  IF (MOD(itime-1, lmt_pas) == 0) THEN   ! time to read
56!$OMP MASTER  ! Only master thread
57     IF (is_mpi_root) THEN ! Only master processus
58        print*,'in limit_slab time to read, itime=',itime
59        read_bils=.TRUE.
60        read_sst=.TRUE.
61        read_siv=.TRUE.
62       
63        ierr = NF90_OPEN ('limit_slab.nc', NF90_NOWRITE, nid)
64        IF (ierr /= NF90_NOERR) THEN
65            PRINT *,'LIMIT_SLAB file not found'
66            read_bils=.FALSE.
67            read_sst=.FALSE.
68            read_siv=.FALSE.
69        ELSE ! read file
70       
71        ! La tranche de donnees a lire:
72        start(1) = 1
73        start(2) = jour
74        epais(1) = klon_glo
75        epais(2) = 1
76
77!****************************************************************************************
78! 2) Read bils and SST/ ice volume tendency
79!
80!****************************************************************************************
81!
82! Read bils_glo
83        bils_glo(:,:)=0.
84        ! First read first layer
85        ! try first "BILS_OCE01"
86        ierr = NF90_INQ_VARID(nid, 'BILS_OCE01', nvarid)
87        IF (ierr /= NF90_NOERR) THEN
88            ! Else BILS_OCE
89            ierr = NF90_INQ_VARID(nid, 'BILS_OCE', nvarid)
90            IF (ierr /= NF90_NOERR) THEN
91              read_bils=.FALSE.
92            ELSE
93              ierr = NF90_GET_VAR(nid,nvarid,bils_glo(:,1),start,epais)
94              IF (ierr /= NF90_NOERR) read_bils=.FALSE.
95            ENDIF
96        ELSE
97            ierr = NF90_GET_VAR(nid,nvarid,bils_glo(:,1),start,epais)
98            IF (ierr /= NF90_NOERR) read_bils=.FALSE.
99        END IF
100        ! Try next layers if more than 1
101        IF ((nslay.GT.1).AND.read_bils) THEN
102          DO i=2,nslay
103            WRITE(str2,'(i2.2)') i
104            ierr = NF90_INQ_VARID(nid,'BILS_OCE'//str2, nvarid)
105            IF (ierr.EQ.NF90_NOERR) THEN
106              ierr = NF90_GET_VAR(nid,nvarid,bils_glo(:,i),start,epais)
107            ENDIF
108            IF (ierr /= NF90_NOERR) THEN
109              print *,'WARNING : BILS_OCE not found for layer 2'
110            ENDIF
111          ENDDO
112        ENDIF
113
114! Read sst_glo for this day
115        ierr = NF90_INQ_VARID(nid, 'SST', nvarid)
116        IF (ierr /= NF90_NOERR)  THEN
117            read_sst=.FALSE.
118        ELSE
119            ierr = NF90_GET_VAR(nid,nvarid,sst_l_glo,start,epais)
120            IF (ierr /= NF90_NOERR) read_sst=.FALSE.
121! Read sst_glo for one day ahead
122            start(2) = jour + 1
123            IF (start(2) > 360) start(2)=1
124            ierr = NF90_GET_VAR(nid,nvarid,sst_lp1_glo,start,epais)
125            IF (ierr /= NF90_NOERR) read_sst=.FALSE.
126        END IF
127
128! Read siv_glo for this day
129        ierr = NF90_INQ_VARID(nid, 'SICV', nvarid)
130        IF (ierr /= NF90_NOERR)  THEN
131            read_siv=.FALSE.
132        ELSE
133            start(2) = jour
134            ierr = NF90_GET_VAR(nid,nvarid,siv_l_glo,start,epais)
135            IF (ierr /= NF90_NOERR) read_siv=.FALSE.
136! Read siv_glo for one day ahead
137            start(2) = jour + 1
138            IF (start(2) > 360) start(2)=1
139            ierr = NF90_GET_VAR(nid,nvarid,siv_lp1_glo,start,epais)
140            IF (ierr /= NF90_NOERR) read_siv=.FALSE.
141        END IF
142
143!****************************************************************************************
144! 5) Close file and distribute variables to all processus
145!
146!****************************************************************************************
147        ierr = NF90_CLOSE(nid)
148        IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Pb when closing file', 1)
149        END IF ! Read File
150        IF (read_sst) THEN
151! Calculate difference in temperature between this day and one ahead
152            DO i=1, klon_glo
153               diff_sst_glo(i) = sst_lp1_glo(i) - sst_l_glo(i)
154            END DO
155        END IF !read_sst
156        IF (read_siv) THEN
157! Calculate difference in temperature between this day and one ahead
158            DO i=1, klon_glo
159               diff_siv_glo(i) = siv_lp1_glo(i) - siv_l_glo(i)
160            END DO
161        END IF !read_siv
162     ENDIF ! is_mpi_root
163
164!$OMP END MASTER
165!$OMP BARRIER
166       
167! Send fields to all processes
168! Give default values if needed
169     CALL bcast(read_bils)
170     CALL bcast(read_sst)
171     CALL bcast(read_siv)
172     PRINT *,'limit_slab sst',read_sst,'siv',read_siv,'qflux',read_bils
173     IF (read_bils) THEN
174         CALL Scatter(bils_glo, bils_save)
175     ELSE
176         bils_save(:,:)=0.
177     END IF
178     IF (read_sst) THEN
179         CALL Scatter(diff_sst_glo, diff_sst_save)
180     ELSE
181         diff_sst_save(:)=0.
182     END IF
183     IF (read_siv) THEN
184         CALL Scatter(diff_siv_glo, diff_siv_save)
185     ELSE
186         diff_siv_save(:)=0.
187     END IF
188     
189  ENDIF ! time to read
190
191  lmt_bils(:,:) = bils_save(:,:)
192  diff_sst(:) = diff_sst_save(:)
193  diff_siv(:) = diff_siv_save(:)
194
195END SUBROUTINE limit_slab
Note: See TracBrowser for help on using the repository browser.