| 1 | ! ============================================================================================================================== |
|---|
| 2 | ! MODULE : orch_Write_Field |
|---|
| 3 | ! |
|---|
| 4 | ! CONTACT : orchidee-help _at_ listes.ipsl.fr |
|---|
| 5 | ! |
|---|
| 6 | ! LICENCE : IPSL (2006) |
|---|
| 7 | ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC |
|---|
| 8 | ! |
|---|
| 9 | !>\BRIEF Set of low level interfaces to create netcdf output files to test values of variables in sequentiel mode |
|---|
| 10 | !! |
|---|
| 11 | !!\n DESCRIPTION : Set of low level interfaces to create netcdf output files to test values of variables in sequentiel mode. |
|---|
| 12 | !! The interfaces in this module are only used by orch_write_field_p to create high level interfaces. |
|---|
| 13 | !! These interfaces should only be called by the master process. |
|---|
| 14 | !! |
|---|
| 15 | !! RECENT CHANGE(S): None |
|---|
| 16 | !! |
|---|
| 17 | !! REFERENCES(S) : None |
|---|
| 18 | !! |
|---|
| 19 | !! SVN : |
|---|
| 20 | !! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/orch_write_field.f90 $ |
|---|
| 21 | !! $Date: 2017-06-28 16:04:50 +0200 (Wed, 28 Jun 2017) $ |
|---|
| 22 | !! $Revision: 4470 $ |
|---|
| 23 | !! \n |
|---|
| 24 | !_ ================================================================================================================================ |
|---|
| 25 | MODULE orch_Write_Field |
|---|
| 26 | |
|---|
| 27 | USE mod_orchidee_para |
|---|
| 28 | |
|---|
| 29 | IMPLICIT NONE |
|---|
| 30 | |
|---|
| 31 | INTEGER, PARAMETER :: MaxWriteField = 100 |
|---|
| 32 | INTEGER, DIMENSION(MaxWriteField),SAVE :: FieldId |
|---|
| 33 | INTEGER, DIMENSION(MaxWriteField),SAVE :: FieldVarId |
|---|
| 34 | INTEGER, DIMENSION(MaxWriteField),SAVE :: FieldIndex |
|---|
| 35 | CHARACTER(len=255), DIMENSION(MaxWriteField) :: FieldName |
|---|
| 36 | |
|---|
| 37 | INTEGER, SAVE,DIMENSION(:), ALLOCATABLE :: Index_Write_Field |
|---|
| 38 | INTEGER,SAVE :: iim |
|---|
| 39 | INTEGER,SAVE :: jjm |
|---|
| 40 | INTEGER,SAVE :: NbPoint |
|---|
| 41 | REAL, PARAMETER :: undef_var=0. |
|---|
| 42 | |
|---|
| 43 | INTEGER,SAVE :: NbField = 0 |
|---|
| 44 | |
|---|
| 45 | !! ============================================================================================================================== |
|---|
| 46 | !! INTERFACE : WriteField |
|---|
| 47 | !! |
|---|
| 48 | !>\BRIEF set of routines to write real fields (of 1d, 2d, 3d, 4d) in netcdf output file |
|---|
| 49 | !! |
|---|
| 50 | !! DESCRIPTION : set of routines to write real fields (of 1d, 2d, 3d, 4d) in netcdf output file |
|---|
| 51 | !! CALL WriteField("MyVariable", variable_array) |
|---|
| 52 | !! will create a file MyVariable.nc with all value of variable_array |
|---|
| 53 | !! |
|---|
| 54 | !! \n |
|---|
| 55 | !_ ================================================================================================================================ |
|---|
| 56 | INTERFACE WriteField |
|---|
| 57 | MODULE PROCEDURE WriteField_4d,WriteField_3d,WriteField_2d,WriteField_1d |
|---|
| 58 | END INTERFACE WriteField |
|---|
| 59 | |
|---|
| 60 | !! ============================================================================================================================== |
|---|
| 61 | !! INTERFACE : WriteFieldI |
|---|
| 62 | !! |
|---|
| 63 | !>\BRIEF set of routines to write integer fields (of 1d, 2d, 3d, 4d) in netcdf output file |
|---|
| 64 | !! |
|---|
| 65 | !! DESCRIPTION : set of routines to write integer fields (of 1d, 2d, 3d, 4d) in netcdf output file |
|---|
| 66 | !! CALL WriteFieldI("MyVariable", variable_array) |
|---|
| 67 | !! will create a file MyVariable.nc with all value of variable_array |
|---|
| 68 | !! |
|---|
| 69 | !! \n |
|---|
| 70 | !_ ================================================================================================================================ |
|---|
| 71 | INTERFACE WriteFieldI |
|---|
| 72 | MODULE PROCEDURE WriteFieldI_3d,WriteFieldI_2d,WriteFieldI_1d |
|---|
| 73 | END INTERFACE WriteFieldI |
|---|
| 74 | |
|---|
| 75 | PRIVATE :: iim,jjm,NbPoint |
|---|
| 76 | CONTAINS |
|---|
| 77 | |
|---|
| 78 | SUBROUTINE Init_WriteField(iim0,jjm0,NbPoint0,Index0) |
|---|
| 79 | IMPLICIT NONE |
|---|
| 80 | INTEGER,INTENT(in) :: iim0 |
|---|
| 81 | INTEGER,INTENT(in) :: jjm0 |
|---|
| 82 | INTEGER,INTENT(in) :: NbPoint0 |
|---|
| 83 | INTEGER,INTENT(in) :: Index0(NbPoint0) |
|---|
| 84 | |
|---|
| 85 | iim=iim0 |
|---|
| 86 | jjm=jjm0 |
|---|
| 87 | Nbpoint=Nbpoint0 |
|---|
| 88 | ALLOCATE(Index_Write_Field(NbPoint)) |
|---|
| 89 | Index_Write_Field(:)=Index0(:) |
|---|
| 90 | END SUBROUTINE Init_WriteField |
|---|
| 91 | |
|---|
| 92 | FUNCTION GetFieldIndex(name) |
|---|
| 93 | IMPLICIT NONE |
|---|
| 94 | INTEGER :: GetFieldindex |
|---|
| 95 | CHARACTER(len=*) :: name |
|---|
| 96 | |
|---|
| 97 | CHARACTER(len=255) :: TrueName |
|---|
| 98 | INTEGER :: i |
|---|
| 99 | |
|---|
| 100 | |
|---|
| 101 | TrueName=TRIM(ADJUSTL(name)) |
|---|
| 102 | |
|---|
| 103 | GetFieldIndex=-1 |
|---|
| 104 | DO i=1,NbField |
|---|
| 105 | IF (TrueName==FieldName(i)) THEN |
|---|
| 106 | GetFieldIndex=i |
|---|
| 107 | EXIT |
|---|
| 108 | ENDIF |
|---|
| 109 | ENDDO |
|---|
| 110 | END FUNCTION GetFieldIndex |
|---|
| 111 | |
|---|
| 112 | SUBROUTINE WriteFieldI_3d(name,Field) |
|---|
| 113 | IMPLICIT NONE |
|---|
| 114 | CHARACTER(len=*) :: name |
|---|
| 115 | REAL, DIMENSION(:,:,:) :: Field |
|---|
| 116 | INTEGER, DIMENSION(3) :: Dim |
|---|
| 117 | INTEGER,DIMENSION(4) :: Dim_tmp |
|---|
| 118 | INTEGER :: i |
|---|
| 119 | |
|---|
| 120 | REAL, ALLOCATABLE, DIMENSION(:,:,:) :: Field_tmp |
|---|
| 121 | |
|---|
| 122 | Dim=SHAPE(Field) |
|---|
| 123 | ALLOCATE(Field_tmp(iim*jjm,DIM(2),DIM(3))) |
|---|
| 124 | field_tmp(:,:,:)=undef_var |
|---|
| 125 | |
|---|
| 126 | DO i=1,NbPoint |
|---|
| 127 | field_tmp(Index_Write_Field(i),:,:)=Field(i,:,:) |
|---|
| 128 | ENDDO |
|---|
| 129 | |
|---|
| 130 | Dim_tmp(1)=iim |
|---|
| 131 | Dim_tmp(2)=jjm |
|---|
| 132 | Dim_tmp(3)=DIM(2) |
|---|
| 133 | Dim_tmp(4)=DIM(3) |
|---|
| 134 | CALL WriteField_gen(name,Field_tmp,4,Dim_tmp) |
|---|
| 135 | |
|---|
| 136 | DEALLOCATE(Field_tmp) |
|---|
| 137 | END SUBROUTINE WriteFieldI_3d |
|---|
| 138 | |
|---|
| 139 | SUBROUTINE WriteFieldI_2d(name,Field) |
|---|
| 140 | IMPLICIT NONE |
|---|
| 141 | CHARACTER(len=*) :: name |
|---|
| 142 | REAL, DIMENSION(:,:) :: Field |
|---|
| 143 | INTEGER, DIMENSION(2) :: Dim |
|---|
| 144 | INTEGER,DIMENSION(3) :: Dim_tmp |
|---|
| 145 | INTEGER :: i |
|---|
| 146 | |
|---|
| 147 | REAL, ALLOCATABLE, DIMENSION(:,:) :: Field_tmp |
|---|
| 148 | |
|---|
| 149 | Dim=SHAPE(Field) |
|---|
| 150 | ALLOCATE(Field_tmp(iim*jjm,DIM(2))) |
|---|
| 151 | field_tmp(:,:)=undef_var |
|---|
| 152 | |
|---|
| 153 | DO i=1,NbPoint |
|---|
| 154 | field_tmp(Index_Write_Field(i),:)=Field(i,:) |
|---|
| 155 | ENDDO |
|---|
| 156 | |
|---|
| 157 | Dim_tmp(1)=iim |
|---|
| 158 | Dim_tmp(2)=jjm |
|---|
| 159 | Dim_tmp(3)=DIM(2) |
|---|
| 160 | |
|---|
| 161 | CALL WriteField_gen(name,Field_tmp,3,Dim_tmp) |
|---|
| 162 | |
|---|
| 163 | DEALLOCATE(Field_tmp) |
|---|
| 164 | END SUBROUTINE WriteFieldI_2d |
|---|
| 165 | |
|---|
| 166 | SUBROUTINE WriteFieldI_1d(name,Field) |
|---|
| 167 | IMPLICIT NONE |
|---|
| 168 | CHARACTER(len=*) :: name |
|---|
| 169 | REAL, DIMENSION(:) :: Field |
|---|
| 170 | INTEGER, DIMENSION(1) :: Dim |
|---|
| 171 | INTEGER,DIMENSION(2) :: Dim_tmp |
|---|
| 172 | INTEGER :: i |
|---|
| 173 | |
|---|
| 174 | REAL, ALLOCATABLE, DIMENSION(:) :: Field_tmp |
|---|
| 175 | |
|---|
| 176 | Dim=SHAPE(Field) |
|---|
| 177 | ALLOCATE(Field_tmp(iim*jjm)) |
|---|
| 178 | field_tmp(:)=undef_var |
|---|
| 179 | |
|---|
| 180 | DO i=1,NbPoint |
|---|
| 181 | field_tmp(Index_Write_Field(i))=Field(i) |
|---|
| 182 | ENDDO |
|---|
| 183 | |
|---|
| 184 | Dim_tmp(1)=iim |
|---|
| 185 | Dim_tmp(2)=jjm |
|---|
| 186 | |
|---|
| 187 | CALL WriteField_gen(name,Field_tmp,2,Dim_tmp) |
|---|
| 188 | |
|---|
| 189 | DEALLOCATE(Field_tmp) |
|---|
| 190 | END SUBROUTINE WriteFieldI_1d |
|---|
| 191 | |
|---|
| 192 | SUBROUTINE WriteField_4d(name,Field) |
|---|
| 193 | IMPLICIT NONE |
|---|
| 194 | CHARACTER(len=*) :: name |
|---|
| 195 | REAL, DIMENSION(:,:,:,:) :: Field |
|---|
| 196 | INTEGER, DIMENSION(4) :: Dim |
|---|
| 197 | |
|---|
| 198 | Dim=SHAPE(Field) |
|---|
| 199 | CALL WriteField_gen(name,Field,4,Dim) |
|---|
| 200 | |
|---|
| 201 | END SUBROUTINE WriteField_4d |
|---|
| 202 | |
|---|
| 203 | SUBROUTINE WriteField_3d(name,Field) |
|---|
| 204 | IMPLICIT NONE |
|---|
| 205 | CHARACTER(len=*) :: name |
|---|
| 206 | REAL, DIMENSION(:,:,:) :: Field |
|---|
| 207 | INTEGER, DIMENSION(3) :: Dim |
|---|
| 208 | |
|---|
| 209 | Dim=SHAPE(Field) |
|---|
| 210 | CALL WriteField_gen(name,Field,3,Dim) |
|---|
| 211 | |
|---|
| 212 | END SUBROUTINE WriteField_3d |
|---|
| 213 | |
|---|
| 214 | SUBROUTINE WriteField_2d(name,Field) |
|---|
| 215 | IMPLICIT NONE |
|---|
| 216 | CHARACTER(len=*) :: name |
|---|
| 217 | REAL, DIMENSION(:,:) :: Field |
|---|
| 218 | INTEGER, DIMENSION(2) :: Dim |
|---|
| 219 | |
|---|
| 220 | Dim=SHAPE(Field) |
|---|
| 221 | CALL WriteField_gen(name,Field,2,Dim) |
|---|
| 222 | |
|---|
| 223 | END SUBROUTINE WriteField_2d |
|---|
| 224 | |
|---|
| 225 | SUBROUTINE WriteField_1d(name,Field) |
|---|
| 226 | IMPLICIT NONE |
|---|
| 227 | CHARACTER(len=*) :: name |
|---|
| 228 | REAL, DIMENSION(:) :: Field |
|---|
| 229 | INTEGER, DIMENSION(1) :: Dim |
|---|
| 230 | |
|---|
| 231 | Dim=SHAPE(Field) |
|---|
| 232 | CALL WriteField_gen(name,Field,1,Dim) |
|---|
| 233 | |
|---|
| 234 | END SUBROUTINE WriteField_1d |
|---|
| 235 | |
|---|
| 236 | SUBROUTINE CreateNewField(name,NbDim,DimSize) |
|---|
| 237 | USE ioipsl |
|---|
| 238 | IMPLICIT NONE |
|---|
| 239 | INCLUDE 'netcdf.inc' |
|---|
| 240 | CHARACTER(len=*) :: name |
|---|
| 241 | INTEGER :: NbDim |
|---|
| 242 | INTEGER :: DimSize(NbDim) |
|---|
| 243 | INTEGER :: TabDim(NbDim+1) |
|---|
| 244 | INTEGER :: status |
|---|
| 245 | |
|---|
| 246 | |
|---|
| 247 | NbField=NbField+1 |
|---|
| 248 | FieldName(NbField)=TRIM(ADJUSTL(name)) |
|---|
| 249 | FieldIndex(NbField)=1 |
|---|
| 250 | |
|---|
| 251 | WRITE(numout,*) 'CREATE_NEW_FIELD ',name,NbDim,DimSize |
|---|
| 252 | CALL FLUSH(6) |
|---|
| 253 | status = NF_CREATE(TRIM(ADJUSTL(name))//'.nc', NF_CLOBBER, FieldId(NbField)) |
|---|
| 254 | IF (NbDim>=1) status = NF_DEF_DIM(FieldId(NbField),'I',DimSize(1),TabDim(1)) |
|---|
| 255 | IF (NbDim>=2) status = NF_DEF_DIM(FieldId(NbField),'J',DimSize(2),TabDim(2)) |
|---|
| 256 | IF (NbDim>=3) status = NF_DEF_DIM(FieldId(NbField),'K',DimSize(3),TabDim(3)) |
|---|
| 257 | IF (NbDim>=4) status = NF_DEF_DIM(FieldId(NbField),'L',DimSize(4),TabDim(4)) |
|---|
| 258 | status = NF_DEF_DIM(FieldId(NbField),'iter',NF_UNLIMITED,TabDim(NbDim+1)) |
|---|
| 259 | status = NF_DEF_VAR(FieldId(NbField),FieldName(NbField),NF_DOUBLE,NbDim+1,TabDim,FieldVarId(NbField)) |
|---|
| 260 | status = NF_ENDDEF(FieldId(NbField)) |
|---|
| 261 | |
|---|
| 262 | END SUBROUTINE CreateNewField |
|---|
| 263 | |
|---|
| 264 | FUNCTION int2str(int) |
|---|
| 265 | IMPLICIT NONE |
|---|
| 266 | INTEGER, PARAMETER :: MaxLen=10 |
|---|
| 267 | INTEGER,INTENT(in) :: int |
|---|
| 268 | CHARACTER(len=MaxLen) :: int2str |
|---|
| 269 | LOGICAL :: flag |
|---|
| 270 | INTEGER :: i |
|---|
| 271 | flag=.TRUE. |
|---|
| 272 | |
|---|
| 273 | i=int |
|---|
| 274 | |
|---|
| 275 | int2str='' |
|---|
| 276 | DO WHILE (flag) |
|---|
| 277 | int2str=CHAR(MOD(i,10)+48)//int2str |
|---|
| 278 | i=i/10 |
|---|
| 279 | IF (i==0) flag=.FALSE. |
|---|
| 280 | ENDDO |
|---|
| 281 | END FUNCTION int2str |
|---|
| 282 | |
|---|
| 283 | |
|---|
| 284 | END MODULE Orch_Write_Field |
|---|
| 285 | |
|---|
| 286 | SUBROUTINE WriteField_gen(name,Field,NbDim,DimSize) |
|---|
| 287 | USE orch_write_field |
|---|
| 288 | IMPLICIT NONE |
|---|
| 289 | INCLUDE 'netcdf.inc' |
|---|
| 290 | CHARACTER(len=*) :: name |
|---|
| 291 | INTEGER :: NbDim |
|---|
| 292 | INTEGER,DIMENSION(NbDim) :: DimSize |
|---|
| 293 | REAL,DIMENSION(*) :: Field |
|---|
| 294 | |
|---|
| 295 | INTEGER :: status |
|---|
| 296 | INTEGER :: ind |
|---|
| 297 | INTEGER :: start(NbDim+1) |
|---|
| 298 | INTEGER :: COUNT(NbDim+1) |
|---|
| 299 | INTEGER :: i |
|---|
| 300 | |
|---|
| 301 | Ind=GetFieldIndex(name) |
|---|
| 302 | IF (Ind==-1) THEN |
|---|
| 303 | CALL CreateNewField(name,NbDim,DimSize) |
|---|
| 304 | Ind=GetFieldIndex(name) |
|---|
| 305 | ELSE |
|---|
| 306 | FieldIndex(Ind)=FieldIndex(Ind)+1 |
|---|
| 307 | ENDIF |
|---|
| 308 | |
|---|
| 309 | DO i=1,NbDim |
|---|
| 310 | start(i)=1 |
|---|
| 311 | COUNT(i)=DimSize(i) |
|---|
| 312 | ENDDO |
|---|
| 313 | start(NbDim+1)=FieldIndex(Ind) |
|---|
| 314 | COUNT(NbDim+1)=1 |
|---|
| 315 | |
|---|
| 316 | status = NF_PUT_VARA_DOUBLE(FieldId(Ind),FieldVarId(Ind),start,count,Field) |
|---|
| 317 | status = NF_SYNC(FieldId(Ind)) |
|---|
| 318 | |
|---|
| 319 | END SUBROUTINE WriteField_gen |
|---|
