GCC Code Coverage Report


Directory: ./
File: phys/condsurf.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 39 0.0%
Branches: 0 16 0.0%

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