Changeset 5128 for LMDZ6/branches/Amaury_dev/libf/dyn3d/dynredem_mod.F90
- Timestamp:
- Jul 25, 2024, 5:47:25 PM (4 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3d/dynredem_mod.F90
r5101 r5128 1 1 MODULE dynredem_mod 2 2 3 USE netcdf, ONLY: nf90_strerror, nf90_noerr,nf90_redef,nf90_put_var,nf90_enddef,nf90_put_att,&4 nf90_inq_varid, nf90_get_var,nf90_def_var3 USE netcdf, ONLY: nf90_strerror, nf90_noerr, nf90_redef, nf90_put_var, nf90_enddef, nf90_put_att, & 4 nf90_inq_varid, nf90_get_var, nf90_def_var 5 5 USE lmdz_cppkeys_wrapper, ONLY: nf90_format 6 6 IMPLICIT NONE; PRIVATE … … 9 9 include "dimensions.h" 10 10 include "paramet.h" 11 CHARACTER(LEN =256), SAVE :: fil, modname12 INTEGER, 11 CHARACTER(LEN = 256), SAVE :: fil, modname 12 INTEGER, SAVE :: nvarid 13 13 14 14 … … 16 16 17 17 18 !===============================================================================19 20 SUBROUTINE dynredem_write_u(ncid,id,var,ll)21 22 !===============================================================================23 ! Arguments:24 INTEGER,INTENT(IN) :: ncid25 CHARACTER(LEN=*), INTENT(IN) :: id26 REAL, INTENT(IN) :: var(iip1,jjp1,ll)27 INTEGER,INTENT(IN) :: ll28 !===============================================================================29 ! Local variables:30 INTEGER :: start(4), count(4)31 !===============================================================================32 start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]33 CALL err(nf90_inq_varid(ncid,id,nvarid),"inq",id)34 CALL err(nf90_put_var(ncid,nvarid,var,start,count),"put",id)35 36 END SUBROUTINE dynredem_write_u37 38 !===============================================================================39 40 41 !===============================================================================42 43 SUBROUTINE dynredem_write_v(ncid,id,var,ll)44 45 !===============================================================================46 ! Arguments:47 INTEGER,INTENT(IN) :: ncid48 CHARACTER(LEN=*), INTENT(IN) :: id49 REAL, INTENT(IN) :: var(iip1,jjm,ll)50 INTEGER,INTENT(IN) :: ll51 !===============================================================================52 ! Local variables:53 INTEGER :: start(4), count(4)54 !===============================================================================55 start(:)=[1,1,1,1]; count(:)=[iip1,jjm,ll,1]56 CALL err(nf90_inq_varid(ncid,id,nvarid),"inq",id)57 CALL err(nf90_put_var(ncid,nvarid,var,start,count),"put",id)58 59 END SUBROUTINE dynredem_write_v60 61 !===============================================================================62 63 64 !===============================================================================65 66 SUBROUTINE dynredem_read_u(ncid,id,var,ll)67 68 !===============================================================================69 ! Arguments:70 INTEGER, INTENT(IN):: ncid71 CHARACTER(LEN=*), INTENT(IN):: id72 REAL, INTENT(OUT) :: var(iip1,jjp1,ll)73 INTEGER, INTENT(IN):: ll74 !===============================================================================75 ! Local variables:76 INTEGER :: start(4), count(4)77 !===============================================================================78 start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]79 CALL err(nf90_inq_varid(ncid,id,nvarid),"inq",id)80 CALL err(nf90_get_var(ncid,nvarid,var,start,count),"get",id)81 82 END SUBROUTINE dynredem_read_u 83 84 !===============================================================================85 86 87 !===============================================================================88 89 SUBROUTINE cre_var(ncid,var,title,did,units)90 91 !===============================================================================92 ! Arguments:93 INTEGER,INTENT(IN) :: ncid94 CHARACTER(LEN=*),INTENT(IN) :: var, title95 INTEGER,INTENT(IN) :: did(:)96 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units97 !===============================================================================98 CALL err(nf90_def_var(ncid,var,nf90_format,did,nvarid),"inq",var)99 IF(title/="") CALL err(nf90_put_att(ncid,nvarid,"title",title),var)100 IF(PRESENT(units)) CALL err(nf90_put_att(ncid,nvarid,"units",units),var)101 102 END SUBROUTINE cre_var103 104 !===============================================================================105 106 107 !===============================================================================108 109 SUBROUTINE put_var1(ncid,var,title,did,v,units)110 111 !===============================================================================112 ! Arguments:113 INTEGER,INTENT(IN) :: ncid114 CHARACTER(LEN=*),INTENT(IN) :: var, title115 INTEGER,INTENT(IN) :: did(1)116 REAL,INTENT(IN) :: v(:)117 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units118 !===============================================================================119 IF( PRESENT(units)) CALL cre_var(ncid,var,title,did,units)120 IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)121 CALL err(nf90_enddef(ncid))122 CALL err(nf90_put_var(ncid,nvarid,v),"put",var)123 CALL err(nf90_redef(ncid))124 125 END SUBROUTINE put_var1126 127 !===============================================================================128 129 130 !===============================================================================131 132 SUBROUTINE put_var2(ncid,var,title,did,v,units)133 134 !===============================================================================135 ! Arguments:136 INTEGER,INTENT(IN) :: ncid137 CHARACTER(LEN=*),INTENT(IN) :: var, title138 INTEGER,INTENT(IN) :: did(2)139 REAL, INTENT(IN) :: v(:,:)140 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units141 !===============================================================================142 IF( PRESENT(units)) CALL cre_var(ncid,var,title,did,units)143 IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)144 CALL err(nf90_enddef(ncid))145 CALL err(nf90_put_var(ncid,nvarid,v),"put",var)146 CALL err(nf90_redef(ncid))147 148 END SUBROUTINE put_var2149 150 !===============================================================================151 152 153 !===============================================================================154 155 FUNCTION msg(typ,nam)156 157 !===============================================================================158 ! Arguments:159 CHARACTER(LEN=256):: msg !--- STANDARDIZED MESSAGE160 CHARACTER(LEN=*),INTENT(IN) :: typ !--- TYPE OF OPERATION161 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam !--- FIELD NAME162 !===============================================================================163 SELECT CASE(typ)164 CASE('open'); msg ="Opening failed for <"//TRIM(fil)//">"165 CASE('close'); msg ="Closing failed for <"//TRIM(fil)//">"166 CASE('get'); msg ="Reading failed for <"//TRIM(nam)//">"167 CASE('put'); msg ="Writting failed for <"//TRIM(nam)//">"168 CASE('inq'); msg ="Missing field <"//TRIM(nam)//">"169 CASE('fnd'); msg ="Found field <"//TRIM(nam)//">"170 END SELECT171 msg=TRIM(msg)//" in file <"//TRIM(fil)//">"172 173 END FUNCTION msg174 175 !===============================================================================176 177 178 !===============================================================================179 180 SUBROUTINE err(ierr,typ,nam)181 182 !===============================================================================183 ! Arguments:184 INTEGER,INTENT(IN) :: ierr !--- NetCDF ERROR CODE185 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ !--- TYPE OF OPERATION186 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam !--- FIELD NAME187 !===============================================================================188 IF(ierr==nf90_noerr) RETURN189 IF(.NOT.PRESENT(typ)) THEN190 CALL ABORT_gcm(modname,nf90_strerror(ierr),ierr)191 ELSE192 CALL ABORT_gcm(modname,msg(typ,nam),ierr)193 END IF194 195 END SUBROUTINE err196 197 !===============================================================================18 !=============================================================================== 19 20 SUBROUTINE dynredem_write_u(ncid, id, var, ll) 21 22 !=============================================================================== 23 ! Arguments: 24 INTEGER, INTENT(IN) :: ncid 25 CHARACTER(LEN = *), INTENT(IN) :: id 26 REAL, INTENT(IN) :: var(iip1, jjp1, ll) 27 INTEGER, INTENT(IN) :: ll 28 !=============================================================================== 29 ! Local variables: 30 INTEGER :: start(4), count(4) 31 !=============================================================================== 32 start(:) = [1, 1, 1, 1]; count(:) = [iip1, jjp1, ll, 1] 33 CALL err(nf90_inq_varid(ncid, id, nvarid), "inq", id) 34 CALL err(nf90_put_var(ncid, nvarid, var, start, count), "put", id) 35 36 END SUBROUTINE dynredem_write_u 37 38 !=============================================================================== 39 40 41 !=============================================================================== 42 43 SUBROUTINE dynredem_write_v(ncid, id, var, ll) 44 45 !=============================================================================== 46 ! Arguments: 47 INTEGER, INTENT(IN) :: ncid 48 CHARACTER(LEN = *), INTENT(IN) :: id 49 REAL, INTENT(IN) :: var(iip1, jjm, ll) 50 INTEGER, INTENT(IN) :: ll 51 !=============================================================================== 52 ! Local variables: 53 INTEGER :: start(4), count(4) 54 !=============================================================================== 55 start(:) = [1, 1, 1, 1]; count(:) = [iip1, jjm, ll, 1] 56 CALL err(nf90_inq_varid(ncid, id, nvarid), "inq", id) 57 CALL err(nf90_put_var(ncid, nvarid, var, start, count), "put", id) 58 59 END SUBROUTINE dynredem_write_v 60 61 !=============================================================================== 62 63 64 !=============================================================================== 65 66 SUBROUTINE dynredem_read_u(ncid, id, var, ll) 67 68 !=============================================================================== 69 ! Arguments: 70 INTEGER, INTENT(IN) :: ncid 71 CHARACTER(LEN = *), INTENT(IN) :: id 72 REAL, INTENT(OUT) :: var(iip1, jjp1, ll) 73 INTEGER, INTENT(IN) :: ll 74 !=============================================================================== 75 ! Local variables: 76 INTEGER :: start(4), count(4) 77 !=============================================================================== 78 start(:) = [1, 1, 1, 1]; count(:) = [iip1, jjp1, ll, 1] 79 CALL err(nf90_inq_varid(ncid, id, nvarid), "inq", id) 80 CALL err(nf90_get_var(ncid, nvarid, var, start, count), "get", id) 81 82 END SUBROUTINE dynredem_read_u 83 84 !=============================================================================== 85 86 87 !=============================================================================== 88 89 SUBROUTINE cre_var(ncid, var, title, did, units) 90 91 !=============================================================================== 92 ! Arguments: 93 INTEGER, INTENT(IN) :: ncid 94 CHARACTER(LEN = *), INTENT(IN) :: var, title 95 INTEGER, INTENT(IN) :: did(:) 96 CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: units 97 !=============================================================================== 98 CALL err(nf90_def_var(ncid, var, nf90_format, did, nvarid), "inq", var) 99 IF(title/="") CALL err(nf90_put_att(ncid, nvarid, "title", title), var) 100 IF(PRESENT(units)) CALL err(nf90_put_att(ncid, nvarid, "units", units), var) 101 102 END SUBROUTINE cre_var 103 104 !=============================================================================== 105 106 107 !=============================================================================== 108 109 SUBROUTINE put_var1(ncid, var, title, did, v, units) 110 111 !=============================================================================== 112 ! Arguments: 113 INTEGER, INTENT(IN) :: ncid 114 CHARACTER(LEN = *), INTENT(IN) :: var, title 115 INTEGER, INTENT(IN) :: did(1) 116 REAL, INTENT(IN) :: v(:) 117 CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: units 118 !=============================================================================== 119 IF(PRESENT(units)) CALL cre_var(ncid, var, title, did, units) 120 IF(.NOT.PRESENT(units)) CALL cre_var(ncid, var, title, did) 121 CALL err(nf90_enddef(ncid)) 122 CALL err(nf90_put_var(ncid, nvarid, v), "put", var) 123 CALL err(nf90_redef(ncid)) 124 125 END SUBROUTINE put_var1 126 127 !=============================================================================== 128 129 130 !=============================================================================== 131 132 SUBROUTINE put_var2(ncid, var, title, did, v, units) 133 134 !=============================================================================== 135 ! Arguments: 136 INTEGER, INTENT(IN) :: ncid 137 CHARACTER(LEN = *), INTENT(IN) :: var, title 138 INTEGER, INTENT(IN) :: did(2) 139 REAL, INTENT(IN) :: v(:, :) 140 CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: units 141 !=============================================================================== 142 IF(PRESENT(units)) CALL cre_var(ncid, var, title, did, units) 143 IF(.NOT.PRESENT(units)) CALL cre_var(ncid, var, title, did) 144 CALL err(nf90_enddef(ncid)) 145 CALL err(nf90_put_var(ncid, nvarid, v), "put", var) 146 CALL err(nf90_redef(ncid)) 147 148 END SUBROUTINE put_var2 149 150 !=============================================================================== 151 152 153 !=============================================================================== 154 155 FUNCTION msg(typ, nam) 156 157 !=============================================================================== 158 ! Arguments: 159 CHARACTER(LEN = 256) :: msg !--- STANDARDIZED MESSAGE 160 CHARACTER(LEN = *), INTENT(IN) :: typ !--- TYPE OF OPERATION 161 CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: nam !--- FIELD NAME 162 !=============================================================================== 163 SELECT CASE(typ) 164 CASE('open'); msg = "Opening failed for <" // TRIM(fil) // ">" 165 CASE('close'); msg = "Closing failed for <" // TRIM(fil) // ">" 166 CASE('get'); msg = "Reading failed for <" // TRIM(nam) // ">" 167 CASE('put'); msg = "Writting failed for <" // TRIM(nam) // ">" 168 CASE('inq'); msg = "Missing field <" // TRIM(nam) // ">" 169 CASE('fnd'); msg = "Found field <" // TRIM(nam) // ">" 170 END SELECT 171 msg = TRIM(msg) // " in file <" // TRIM(fil) // ">" 172 173 END FUNCTION msg 174 175 !=============================================================================== 176 177 178 !=============================================================================== 179 180 SUBROUTINE err(ierr, typ, nam) 181 182 !=============================================================================== 183 ! Arguments: 184 INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE 185 CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: typ !--- TYPE OF OPERATION 186 CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: nam !--- FIELD NAME 187 !=============================================================================== 188 IF(ierr==nf90_noerr) RETURN 189 IF(.NOT.PRESENT(typ)) THEN 190 CALL ABORT_gcm(modname, nf90_strerror(ierr), ierr) 191 ELSE 192 CALL ABORT_gcm(modname, msg(typ, nam), ierr) 193 END IF 194 195 END SUBROUTINE err 196 197 !=============================================================================== 198 198 199 199 END MODULE dynredem_mod
Note: See TracChangeset
for help on using the changeset viewer.
