MODULE dynredem_mod USE netcdf, ONLY: nf90_strerror,nf90_noerr,nf90_redef,nf90_put_var,nf90_enddef,nf90_put_att,& nf90_inq_varid,nf90_get_var,nf90_def_var USE lmdz_cppkeys_wrapper, ONLY: nf90_format IMPLICIT NONE; PRIVATE PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err PUBLIC :: cre_var, put_var1, put_var2, fil, modname, msg include "dimensions.h" include "paramet.h" CHARACTER(LEN=256), SAVE :: fil, modname INTEGER, SAVE :: nvarid CONTAINS !=============================================================================== SUBROUTINE dynredem_write_u(ncid,id,var,ll) !=============================================================================== ! Arguments: INTEGER, INTENT(IN) :: ncid CHARACTER(LEN=*), INTENT(IN) :: id REAL, INTENT(IN) :: var(iip1,jjp1,ll) INTEGER, INTENT(IN) :: ll !=============================================================================== ! Local variables: INTEGER :: start(4), count(4) !=============================================================================== start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1] CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id) CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id) END SUBROUTINE dynredem_write_u !=============================================================================== !=============================================================================== SUBROUTINE dynredem_write_v(ncid,id,var,ll) !=============================================================================== ! Arguments: INTEGER, INTENT(IN) :: ncid CHARACTER(LEN=*), INTENT(IN) :: id REAL, INTENT(IN) :: var(iip1,jjm,ll) INTEGER, INTENT(IN) :: ll !=============================================================================== ! Local variables: INTEGER :: start(4), count(4) !=============================================================================== start(:)=[1,1,1,1]; count(:)=[iip1,jjm,ll,1] CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id) CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id) END SUBROUTINE dynredem_write_v !=============================================================================== !=============================================================================== SUBROUTINE dynredem_read_u(ncid,id,var,ll) !=============================================================================== ! Arguments: INTEGER, INTENT(IN) :: ncid CHARACTER(LEN=*), INTENT(IN) :: id REAL, INTENT(OUT) :: var(iip1,jjp1,ll) INTEGER, INTENT(IN) :: ll !=============================================================================== ! Local variables: INTEGER :: start(4), count(4) !=============================================================================== start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1] CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id) CALL err(nf90_get_var(ncid,nvarid,var,start,count),"get",id) END SUBROUTINE dynredem_read_u !=============================================================================== !=============================================================================== SUBROUTINE cre_var(ncid,var,title,did,units) !=============================================================================== ! Arguments: INTEGER, INTENT(IN) :: ncid CHARACTER(LEN=*), INTENT(IN) :: var, title INTEGER, INTENT(IN) :: did(:) CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units !=============================================================================== CALL err(NF90_DEF_VAR(ncid,var,nf90_format,did,nvarid),"inq",var) IF(title/="") CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var) IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var) END SUBROUTINE cre_var !=============================================================================== !=============================================================================== SUBROUTINE put_var1(ncid,var,title,did,v,units) !=============================================================================== ! Arguments: INTEGER, INTENT(IN) :: ncid CHARACTER(LEN=*), INTENT(IN) :: var, title INTEGER, INTENT(IN) :: did(1) REAL, INTENT(IN) :: v(:) CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units !=============================================================================== IF( PRESENT(units)) CALL cre_var(ncid,var,title,did,units) IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did) CALL err(NF90_ENDDEF(ncid)) CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var) CALL err(NF90_REDEF(ncid)) END SUBROUTINE put_var1 !=============================================================================== !=============================================================================== SUBROUTINE put_var2(ncid,var,title,did,v,units) !=============================================================================== ! Arguments: INTEGER, INTENT(IN) :: ncid CHARACTER(LEN=*), INTENT(IN) :: var, title INTEGER, INTENT(IN) :: did(2) REAL, INTENT(IN) :: v(:,:) CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units !=============================================================================== IF( PRESENT(units)) CALL cre_var(ncid,var,title,did,units) IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did) CALL err(NF90_ENDDEF(ncid)) CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var) CALL err(NF90_REDEF(ncid)) END SUBROUTINE put_var2 !=============================================================================== !=============================================================================== FUNCTION msg(typ,nam) !=============================================================================== ! Arguments: CHARACTER(LEN=256) :: msg !--- STANDARDIZED MESSAGE CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam !--- FIELD NAME !=============================================================================== SELECT CASE(typ) CASE('open'); msg="Opening failed for <"//TRIM(fil)//">" CASE('close'); msg="Closing failed for <"//TRIM(fil)//">" CASE('get'); msg="Reading failed for <"//TRIM(nam)//">" CASE('put'); msg="Writting failed for <"//TRIM(nam)//">" CASE('inq'); msg="Missing field <"//TRIM(nam)//">" CASE('fnd'); msg="Found field <"//TRIM(nam)//">" END SELECT msg=TRIM(msg)//" in file <"//TRIM(fil)//">" END FUNCTION msg !=============================================================================== !=============================================================================== SUBROUTINE err(ierr,typ,nam) !=============================================================================== ! Arguments: INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ !--- TYPE OF OPERATION CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam !--- FIELD NAME !=============================================================================== IF(ierr==nf90_noerr) RETURN IF(.NOT.PRESENT(typ)) THEN CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr) ELSE CALL ABORT_gcm(modname,msg(typ,nam),ierr) END IF END SUBROUTINE err !=============================================================================== END MODULE dynredem_mod