libf/dyn3d/dynredem1.f90

SUBROUTINE dynredem1(fichnom, time, vcov, ucov, teta, q, masse, ps)

  ! From dyn3d/dynredem.F, v 1.2 2004/06/22 11:45:30

  ! Ecriture du fichier de redémarrage au format NetCDF

  USE dimens_m, ONLY : llm, nqmx
  USE paramet_m, ONLY : ip1jm, ip1jmp1
  USE temps, ONLY : itaufin, itau_dyn
  USE abort_gcm_m, ONLY : abort_gcm
  USE iniadvtrac_m, ONLY : tname
  use netcdf, only: nf90_open, nf90_write, nf90_noerr, nf90_inq_varid

  IMPLICIT NONE

  REAL, INTENT (IN) :: vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)
  REAL, INTENT (IN) :: ps(ip1jmp1), masse(ip1jmp1, llm)
  REAL, INTENT (IN) :: q(ip1jmp1, llm, nqmx)
  CHARACTER(len=*), INTENT (IN) :: fichnom

  INCLUDE 'netcdf.inc'

  REAL :: time
  INTEGER :: nid, nvarid
  INTEGER :: ierr
  INTEGER :: iq
  INTEGER :: length
  PARAMETER (length=100)
  REAL :: tab_cntrl(length) ! tableau des parametres du run
  CHARACTER (len=20) :: modname
  CHARACTER (len=80) :: abort_message
  INTEGER :: nb = 0

  !---------------------------------------------------------

  PRINT *, 'Call sequence information: dynredem1'

  modname = 'dynredem1'
  ierr = nf90_open(fichnom, nf90_write, nid)
  IF (ierr/=nf90_noerr) THEN
     PRINT *, 'Pb. d ouverture ' // fichnom
     STOP 1
  END IF

  !  Ecriture/extension de la coordonnee temps

  nb = nb + 1
  ierr = nf90_inq_varid(nid, 'temps', nvarid)
  IF (ierr/=nf90_noerr) THEN
     PRINT *, nf_strerror(ierr)
     abort_message = 'Variable temps n est pas definie'
     CALL abort_gcm(modname, abort_message, ierr)
  END IF
  ierr = nf_put_var1_real(nid, nvarid, nb, time)
  PRINT *, 'Enregistrement pour ', nb, time


  !  Re-ecriture du tableau de controle, itaufin n'est plus defini quand
  !  on passe dans dynredem0
  ierr = nf90_inq_varid(nid, 'controle', nvarid)
  IF (ierr/=nf90_noerr) THEN
     abort_message = 'dynredem1: Le champ <controle> est absent'
     ierr = 1
     CALL abort_gcm(modname, abort_message, ierr)
  END IF
  ierr = nf_get_var_real(nid, nvarid, tab_cntrl)
  tab_cntrl(31) = real(itau_dyn+itaufin)
  ierr = nf_put_var_real(nid, nvarid, tab_cntrl)

  !  Ecriture des champs

  ierr = nf90_inq_varid(nid, 'ucov', nvarid)
  IF (ierr/=nf90_noerr) THEN
     PRINT *, 'Variable ucov n est pas definie'
     STOP 1
  END IF
  ierr = nf_put_var_real(nid, nvarid, ucov)

  ierr = nf90_inq_varid(nid, 'vcov', nvarid)
  IF (ierr/=nf90_noerr) THEN
     PRINT *, 'Variable vcov n est pas definie'
     STOP 1
  END IF
  ierr = nf_put_var_real(nid, nvarid, vcov)

  ierr = nf90_inq_varid(nid, 'teta', nvarid)
  IF (ierr/=nf90_noerr) THEN
     PRINT *, 'Variable teta n est pas definie'
     STOP 1
  END IF
  ierr = nf_put_var_real(nid, nvarid, teta)

  DO iq = 1, nqmx
     ierr = nf90_inq_varid(nid, tname(iq), nvarid)
     IF (ierr/=nf90_noerr) THEN
        PRINT *, 'Variable  ', tname(iq), 'n''est pas définie'
        STOP 1
     END IF
     ierr = nf_put_var_real(nid, nvarid, q(1, 1, iq))
  END DO

  ierr = nf90_inq_varid(nid, 'masse', nvarid)
  IF (ierr/=nf90_noerr) THEN
     PRINT *, 'Variable masse n est pas definie'
     STOP 1
  END IF
  ierr = nf_put_var_real(nid, nvarid, masse)

  ierr = nf90_inq_varid(nid, 'ps', nvarid)
  IF (ierr/=nf90_noerr) THEN
     PRINT *, 'Variable ps n est pas definie'
     STOP 1
  END IF
  ierr = nf_put_var_real(nid, nvarid, ps)

  ierr = nf_close(nid)

END SUBROUTINE dynredem1
1	guez	5	SUBROUTINE dynredem1(fichnom, time, vcov, ucov, teta, q, masse, ps)
2	guez	3
3	guez	5	! From dyn3d/dynredem.F, v 1.2 2004/06/22 11:45:30
4	guez	3
5	guez	5	! Ecriture du fichier de redémarrage au format NetCDF
6	guez	3
7	guez	5	USE dimens_m, ONLY : llm, nqmx
8			USE paramet_m, ONLY : ip1jm, ip1jmp1
9			USE temps, ONLY : itaufin, itau_dyn
10			USE abort_gcm_m, ONLY : abort_gcm
11	guez	18	USE iniadvtrac_m, ONLY : tname
12			use netcdf, only: nf90_open, nf90_write, nf90_noerr, nf90_inq_varid
13	guez	3
14			IMPLICIT NONE
15
16	guez	5	REAL, INTENT (IN) :: vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)
17			REAL, INTENT (IN) :: ps(ip1jmp1), masse(ip1jmp1, llm)
18			REAL, INTENT (IN) :: q(ip1jmp1, llm, nqmx)
19			CHARACTER(len=*), INTENT (IN) :: fichnom
20	guez	3
21	guez	5	INCLUDE 'netcdf.inc'
22	guez	3
23	guez	5	REAL :: time
24			INTEGER :: nid, nvarid
25			INTEGER :: ierr
26			INTEGER :: iq
27			INTEGER :: length
28			PARAMETER (length=100)
29			REAL :: tab_cntrl(length) ! tableau des parametres du run
30			CHARACTER (len=20) :: modname
31			CHARACTER (len=80) :: abort_message
32			INTEGER :: nb = 0
33	guez	3
34			!---------------------------------------------------------
35
36	guez	5	PRINT *, 'Call sequence information: dynredem1'
37	guez	3
38			modname = 'dynredem1'
39	guez	18	ierr = nf90_open(fichnom, nf90_write, nid)
40			IF (ierr/=nf90_noerr) THEN
41	guez	5	PRINT *, 'Pb. d ouverture ' // fichnom
42			STOP 1
43			END IF
44	guez	3
45			! Ecriture/extension de la coordonnee temps
46
47			nb = nb + 1
48	guez	18	ierr = nf90_inq_varid(nid, 'temps', nvarid)
49			IF (ierr/=nf90_noerr) THEN
50	guez	5	PRINT *, nf_strerror(ierr)
51			abort_message = 'Variable temps n est pas definie'
52			CALL abort_gcm(modname, abort_message, ierr)
53			END IF
54			ierr = nf_put_var1_real(nid, nvarid, nb, time)
55			PRINT *, 'Enregistrement pour ', nb, time
56	guez	3
57	guez	5
58	guez	3	! Re-ecriture du tableau de controle, itaufin n'est plus defini quand
59			! on passe dans dynredem0
60	guez	18	ierr = nf90_inq_varid(nid, 'controle', nvarid)
61			IF (ierr/=nf90_noerr) THEN
62	guez	5	abort_message = 'dynredem1: Le champ <controle> est absent'
63	guez	3	ierr = 1
64	guez	5	CALL abort_gcm(modname, abort_message, ierr)
65			END IF
66			ierr = nf_get_var_real(nid, nvarid, tab_cntrl)
67			tab_cntrl(31) = real(itau_dyn+itaufin)
68			ierr = nf_put_var_real(nid, nvarid, tab_cntrl)
69	guez	3
70			! Ecriture des champs
71
72	guez	18	ierr = nf90_inq_varid(nid, 'ucov', nvarid)
73			IF (ierr/=nf90_noerr) THEN
74	guez	5	PRINT *, 'Variable ucov n est pas definie'
75			STOP 1
76			END IF
77			ierr = nf_put_var_real(nid, nvarid, ucov)
78	guez	3
79	guez	18	ierr = nf90_inq_varid(nid, 'vcov', nvarid)
80			IF (ierr/=nf90_noerr) THEN
81	guez	5	PRINT *, 'Variable vcov n est pas definie'
82			STOP 1
83			END IF
84			ierr = nf_put_var_real(nid, nvarid, vcov)
85	guez	3
86	guez	18	ierr = nf90_inq_varid(nid, 'teta', nvarid)
87			IF (ierr/=nf90_noerr) THEN
88	guez	5	PRINT *, 'Variable teta n est pas definie'
89			STOP 1
90			END IF
91			ierr = nf_put_var_real(nid, nvarid, teta)
92	guez	3
93	guez	5	DO iq = 1, nqmx
94	guez	18	ierr = nf90_inq_varid(nid, tname(iq), nvarid)
95			IF (ierr/=nf90_noerr) THEN
96	guez	5	PRINT *, 'Variable ', tname(iq), 'n''est pas définie'
97			STOP 1
98			END IF
99			ierr = nf_put_var_real(nid, nvarid, q(1, 1, iq))
100			END DO
101	guez	3
102	guez	18	ierr = nf90_inq_varid(nid, 'masse', nvarid)
103			IF (ierr/=nf90_noerr) THEN
104	guez	5	PRINT *, 'Variable masse n est pas definie'
105			STOP 1
106			END IF
107			ierr = nf_put_var_real(nid, nvarid, masse)
108
109	guez	18	ierr = nf90_inq_varid(nid, 'ps', nvarid)
110			IF (ierr/=nf90_noerr) THEN
111	guez	5	PRINT *, 'Variable ps n est pas definie'
112			STOP 1
113			END IF
114			ierr = nf_put_var_real(nid, nvarid, ps)
115
116			ierr = nf_close(nid)
117
118	guez	3	END SUBROUTINE dynredem1