source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/condsurf.F90 @ 5440

Last change on this file since 5440 was 1992, checked in by lguez, 11 years ago

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

  • 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:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 3.4 KB
Line 
1! $Header$
2
3SUBROUTINE condsurf(jour, jourvrai, lmt_bils)
4  USE dimphy
5  USE mod_grid_phy_lmdz
6  USE mod_phys_lmdz_para
7  USE indice_sol_mod
8  IMPLICIT NONE
9
10  ! I. Musat 05.2005
11
12  ! Lire chaque jour le bilan de chaleur au sol issu
13  ! d'un run atmospherique afin de l'utiliser dans
14  ! dans un run "slab" ocean
15  ! -----------------------------------------
16  ! jour     : input  , numero du jour a lire
17  ! jourvrai : input  , vrai jour de la simulation
18
19  ! lmt_bils: bilan chaleur au sol (a utiliser pour "slab-ocean")
20
21  include "netcdf.inc"
22  INTEGER nid, nvarid
23  INTEGER debut(2)
24  INTEGER epais(2)
25
26  ! ym#include "dimensions.h"
27  ! ym#include "dimphy.h"
28  include "temps.h"
29  include "clesphys.h"
30
31  INTEGER nannemax
32  PARAMETER (nannemax=60)
33
34  INTEGER jour, jourvrai
35  REAL lmt_bils(klon) !bilan chaleur au sol
36
37  ! Variables locales:
38  INTEGER ig, i, kt, ierr
39  LOGICAL ok
40  INTEGER anneelim, anneemax
41  CHARACTER *20 fich
42
43  REAL :: lmt_bils_glo(klon_glo)
44
45  ! c
46  ! c   .....................................................................
47  ! c
48  ! c    Pour lire le fichier limit correspondant vraiment  a l'annee de la
49  ! c     simulation en cours , il suffit de mettre  ok_limitvrai = .TRUE.
50  ! c
51  ! c
52  ! ......................................................................
53
54
55
56  IF (jour<0 .OR. jour>(360-1)) THEN
57    PRINT *, 'Le jour demande n est pas correct: ', jour
58    CALL abort_gcm('condsurf', '', 1)
59  END IF
60
61  anneelim = annee_ref
62  anneemax = annee_ref + nannemax
63
64
65  IF (ok_limitvrai) THEN
66    DO kt = 1, nannemax
67      IF (jourvrai<=(kt-1)*360+359) THEN
68        WRITE (fich, '("limit",i4,".nc")') anneelim
69        ! PRINT *,' Fichier  Limite ',fich
70        GO TO 100
71      END IF
72      anneelim = anneelim + 1
73    END DO
74
75    PRINT *, ' PBS ! Le jour a lire sur le fichier limit ne se '
76    PRINT *, ' trouve pas sur les ', nannemax, ' annees a partir de '
77    PRINT *, ' l annee de debut', annee_ref
78    CALL abort_gcm('condsurf', '', 1)
79
80100 CONTINUE
81
82  ELSE
83
84    WRITE (fich, '("limitNEW.nc")')
85    ! PRINT *,' Fichier  Limite ',fich
86  END IF
87
88  ! Ouvrir le fichier en format NetCDF:
89
90  !$OMP MASTER
91  IF (is_mpi_root) THEN
92    ierr = nf_open(fich, nf_nowrite, nid)
93    IF (ierr/=nf_noerr) THEN
94      WRITE (6, *) ' Pb d''ouverture du fichier ', fich
95      WRITE (6, *) ' Le fichier limit ', fich, ' (avec 4 chiffres , pour'
96      WRITE (6, *) '       l an 2000 )  ,  n existe  pas !  '
97      WRITE (6, *) ' ierr = ', ierr
98      CALL abort_gcm('condsurf', '', 1)
99    END IF
100    ! DO k = 1, jour
101    ! La tranche de donnees a lire:
102
103    debut(1) = 1
104    debut(2) = jourvrai
105    epais(1) = klon_glo
106    epais(2) = 1
107    ! Bilan flux de chaleur au sol:
108
109    ierr = nf_inq_varid(nid, 'BILS', nvarid)
110    IF (ierr/=nf_noerr) THEN
111      CALL abort_gcm('cond_surf', 'Le champ <BILS> est absent', 1)
112    END IF
113    PRINT *, 'debut,epais', debut, epais, 'jour,jourvrai', jour, jourvrai
114#ifdef NC_DOUBLE
115    ierr = nf_get_vara_double(nid, nvarid, debut, epais, lmt_bils_glo)
116#else
117    ierr = nf_get_vara_real(nid, nvarid, debut, epais, lmt_bils_glo)
118#endif
119    IF (ierr/=nf_noerr) THEN
120      CALL abort_gcm('condsurf', 'Lecture echouee pour <BILS>', 1)
121    END IF
122    ! ENDDO !k = 1, jour
123
124    ! Fermer le fichier:
125
126    ierr = nf_close(nid)
127
128  END IF ! is_mpi_root==0
129
130  !$OMP END MASTER
131  CALL scatter(lmt_bils_glo, lmt_bils)
132
133
134
135  ! PRINT*, 'lmt_bils est lu pour jour: ', jour
136
137  RETURN
138END SUBROUTINE condsurf
Note: See TracBrowser for help on using the repository browser.