MODULE def_mod_mod ! !git $Id$ !svn $Id: def_mod.F 1151 2023-02-09 03:08:53Z arango $ !================================================== Hernan G. Arango === ! Copyright (c) 2002-2023 The ROMS/TOMS Group ! ! Licensed under a MIT/X style license ! ! See License_ROMS.md ! !======================================================================= ! ! ! This routine create model/observation output file using either the ! ! standard NetCDF library or the Parallel-IO (PIO) library. The model ! ! fields processed at observations locations. ! ! ! ! For completeness and to allow the Ensemble Kalman Filter (EnKF) ! ! with the First Guess at Appropriate Time (FGAT), several variables ! ! from the input observation file is also written. ! ! ! !======================================================================= ! USE mod_param USE mod_parallel USE mod_fourdvar USE mod_iounits USE mod_ncparam USE mod_scalars USE mod_strings ! USE dateclock_mod, ONLY : time_string USE def_dim_mod, ONLY : def_dim USE def_var_mod, ONLY : def_var USE strings_mod, ONLY : find_string USE strings_mod, ONLY : FoundError USE strings_mod, ONLY : uppercase ! implicit none ! PUBLIC :: def_mod PRIVATE :: def_mod_nf90 ! CONTAINS ! !*********************************************************************** SUBROUTINE def_mod (ng) !*********************************************************************** ! ! Imported variable declarations. ! integer, intent(in) :: ng ! ! Local variable declarations. ! character (len=*), parameter :: MyFile = & & "ROMS/Utility/def_mod.F" ! !----------------------------------------------------------------------- ! Create a new history file according to IO type. !----------------------------------------------------------------------- ! SELECT CASE (DAV(ng)%IOtype) CASE (io_nf90) CALL def_mod_nf90 (ng) CASE DEFAULT IF (Master) WRITE (stdout,10) DAV(ng)%IOtype exit_flag=3 END SELECT IF (FoundError(exit_flag, NoError, 77, MyFile)) RETURN ! 10 FORMAT (' DEF_MOD - Illegal output file type, io_type = ',i0, & & /,11x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.') ! RETURN END SUBROUTINE def_mod ! !*********************************************************************** SUBROUTINE def_mod_nf90 (ng) !*********************************************************************** ! USE mod_netcdf ! USE distribute_mod, ONLY : mp_bcasti ! ! Imported variable declarations. ! integer, intent(in) :: ng ! ! Local variable declarations. ! logical, dimension(NV) :: got_var(NV) logical :: foundAtt(2), foundit ! integer, parameter :: Natt = 25 integer :: iterDim, recordDim, surveyDim, threeDim integer :: datumDim, datumDimP1 integer :: NinnerDim, NinnerDimP1, NinnerDimP2 integer :: NouterDim, NouterDimP1 integer :: stateDim, stateDimP1 integer :: Fcount integer :: i, j, lstr, nvatt, nvdim, status, varid, vindex integer :: OBSncid integer :: vardim(3) integer :: ibuffer(2) ! real(dp) :: Tstart, Tfinal real(r8) :: Aval(6) ! character (len=22 ) :: str_date, end_date character (len=40 ) :: Aname, AttName(2) character (len=80 ) :: string character (len=256) :: ncname character (len=2048) :: AttValue(2) character (len=MaxLen) :: Vinfo(Natt) character (len=*), parameter :: MyFile = & & "ROMS/Utility/def_mod.F"//", def_mod_nf90" ! SourceFile=MyFile ! !----------------------------------------------------------------------- ! Set and report file name. !----------------------------------------------------------------------- ! IF (FoundError(exit_flag, NoError, 142, MyFile)) RETURN ncname=DAV(ng)%name ! IF (Master) THEN IF (LdefMOD(ng)) THEN WRITE (stdout,10) ng, TRIM(ncname) ELSE WRITE (stdout,20) ng, TRIM(ncname) END IF END IF ! ! Initialize local information variable arrays. ! DO i=1,Natt DO j=1,LEN(Vinfo(1)) Vinfo(i)(j:j)=' ' END DO END DO DO i=1,6 Aval(i)=0.0_r8 END DO ! !======================================================================= ! Create a new model/observation file. !======================================================================= ! DEFINE : IF (LdefMOD(ng)) THEN ! ! Open input observations NetCDF. ! IF (OBS(ng)%ncid.eq.-1) THEN CALL netcdf_open (ng, iNLM, OBS(ng)%name, 1, OBSncid) IF (FoundError(exit_flag, NoError, 174, MyFile)) THEN WRITE (stdout,30) TRIM(OBS(ng)%name) RETURN END IF ELSE OBSncid=OBS(ng)%ncid END IF ! ! Inquire about input observations variables. ! CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid) IF (FoundError(exit_flag, NoError, 186, MyFile)) RETURN ! ! Inquire if the 'state_variables' and 'obs_provenance' attributes ! are available in the observations file. ! AttName(1)='state_variables' AttName(2)='obs_provenance' ! CALL netcdf_get_satt (ng, iNLM, OBS(ng)%name, nf90_global, & & AttName, AttValue, foundAtt, & & ncid = OBSncid) IF (FoundError(exit_flag, NoError, 197, MyFile)) RETURN ! ! Create model/observation (DAV) file ! CALL netcdf_create (ng, iNLM, TRIM(ncname), DAV(ng)%ncid) IF (FoundError(exit_flag, NoError, 202, MyFile)) THEN IF (Master) WRITE (stdout,40) TRIM(ncname) RETURN END IF ! !----------------------------------------------------------------------- ! Define dimensions. !----------------------------------------------------------------------- ! status=def_dim(ng, iNLM, DAV(ng)%ncid, ncname, 'record', & & 2, recordDim) IF (FoundError(exit_flag, NoError, 223, MyFile)) RETURN status=def_dim(ng, iNLM, DAV(ng)%ncid, ncname, 'survey', & & Nsurvey(ng), surveyDim) IF (FoundError(exit_flag, NoError, 227, MyFile)) RETURN status=def_dim(ng, iNLM, DAV(ng)%ncid, ncname, 'state_var', & & NobsVar(ng), stateDim) IF (FoundError(exit_flag, NoError, 231, MyFile)) RETURN status=def_dim(ng, iNLM, DAV(ng)%ncid, ncname, 'cost_var', & & NobsVar(ng)+1, stateDimP1) IF (FoundError(exit_flag, NoError, 235, MyFile)) RETURN status=def_dim(ng, iNLM, DAV(ng)%ncid, ncname, 'datum', & & Ndatum(ng), datumDim) IF (FoundError(exit_flag, NoError, 239, MyFile)) RETURN status=def_dim(ng, iNLM, DAV(ng)%ncid, ncname, 'datum+1', & & Ndatum(ng)+1, datumDimP1) IF (FoundError(exit_flag, NoError, 245, MyFile)) RETURN status=def_dim(ng, iNLM, DAV(ng)%ncid, ncname, 'Nouter', & & Nouter, NouterDim) IF (FoundError(exit_flag, NoError, 249, MyFile)) RETURN status=def_dim(ng, iNLM, DAV(ng)%ncid, ncname, 'Nouter+1', & & Nouter+1, NouterDimP1) IF (FoundError(exit_flag, NoError, 253, MyFile)) RETURN status=def_dim(ng, iNLM, DAV(ng)%ncid, ncname, 'Ninner', & & Ninner, NinnerDim) IF (FoundError(exit_flag, NoError, 257, MyFile)) RETURN status=def_dim(ng, iNLM, DAV(ng)%ncid, ncname, 'Ninner+1', & & Ninner+1, NinnerDimP1) IF (FoundError(exit_flag, NoError, 261, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Define global attributes. !----------------------------------------------------------------------- ! IF (OutThread) THEN ! ! File type. ! IF (exit_flag.eq.NoError) THEN string='ROMS/TOMS 4D-Var output observation processing file' status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'type', TRIM(string)) IF (FoundError(status, nf90_noerr, 294, MyFile)) THEN WRITE (stdout,50) 'type', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF ! ! Algorithm. ! IF (exit_flag.eq.NoError) THEN string=uppercase('rbl4dvar') status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'Algorithm', TRIM(string)) IF (FoundError(status, nf90_noerr, 337, MyFile)) THEN WRITE (stdout,50) 'type', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF ! ! Set cycle start and final time and dates attributes. ! IF (INItime(ng).lt.0.0_dp) THEN Tstart=time(ng)+dt(ng) ! called after 'initial' ELSE Tstart=INItime(ng) END IF Tfinal=Tstart+ntimes(ng)*dt(ng) CALL time_string (Tstart, str_date) CALL time_string (Tfinal, end_date) ! IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'str_day', Tstart*sec2day) IF (FoundError(status, nf90_noerr, 358, MyFile)) THEN WRITE (stdout,50) 'str_day', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF ! IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'end_day', Tfinal*sec2day) IF (FoundError(status, nf90_noerr, 368, MyFile)) THEN WRITE (stdout,50) 'end_day', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF ! IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'str_date', str_date) IF (FoundError(status, nf90_noerr, 378, MyFile)) THEN WRITE (stdout,50) 'str_date', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF ! IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'end_date', end_date) IF (FoundError(status, nf90_noerr, 388, MyFile)) THEN WRITE (stdout,50) 'end_date', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF ! ! Input observations file. ! IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'obs_file', TRIM(OBS(ng)%name)) IF (FoundError(status, nf90_noerr, 400, MyFile)) THEN WRITE (stdout,50) 'obs_file', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF ! ! State variables IDs for observations. Copy global attribute from ! observation file. ! IF (exit_flag.eq.NoError) THEN IF (foundAtt(1)) THEN status=nf90_copy_att(OBSncid, nf90_global, & & 'state_variables', & & DAV(ng)%ncid, nf90_global) IF (FoundError(status, nf90_noerr, 415, MyFile)) THEN WRITE (stdout,50) 'state_variables', TRIM(ncname) exit_flag=3 ioerror=status END IF IF (FoundError(exit_flag, NoError, & & 421, MyFile)) RETURN END IF END IF ! ! Observations provenance IDs. Copy global attribute from ! observation file. ! IF (exit_flag.eq.NoError) THEN IF (foundAtt(2)) THEN status=nf90_copy_att(OBSncid, nf90_global, & & 'obs_provenance', & & DAV(ng)%ncid, nf90_global) IF (FoundError(status, nf90_noerr, 433, MyFile)) THEN WRITE (stdout,50) 'obs_provenance', TRIM(ncname) exit_flag=3 ioerror=status END IF IF (FoundError(exit_flag, NoError, & & 439, MyFile)) RETURN END IF END IF ! ! SVN repository information. ! IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'svn_url', TRIM(svn_url)) IF (FoundError(status, nf90_noerr, 448, MyFile)) THEN WRITE (stdout,50) 'svn_url', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'svn_rev', TRIM(svn_rev)) IF (FoundError(status, nf90_noerr, 460, MyFile)) THEN WRITE (stdout,50) 'svn_rev', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'code_dir', TRIM(Rdir)) IF (FoundError(status, nf90_noerr, 472, MyFile)) THEN WRITE (stdout,50) 'code_dir', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'header_dir', TRIM(Hdir)) IF (FoundError(status, nf90_noerr, 484, MyFile)) THEN WRITE (stdout,50) 'header_dir', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'header_file', TRIM(Hfile)) IF (FoundError(status, nf90_noerr, 496, MyFile)) THEN WRITE (stdout,50) 'header_file', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF ! ! Attributes describing platform and compiler ! IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'os', TRIM(my_os)) IF (FoundError(status, nf90_noerr, 509, MyFile)) THEN WRITE (stdout,50) 'os', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'cpu', TRIM(my_cpu)) IF (FoundError(status, nf90_noerr, 519, MyFile)) THEN WRITE (stdout,50) 'cpu', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'compiler_system', TRIM(my_fort)) IF (FoundError(status, nf90_noerr, 529, MyFile)) THEN WRITE (stdout,50) 'compiler_system', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF IF (exit_flag.eq.NoError) THEN status=nf90_put_att(DAV(ng)%ncid,nf90_global, & & 'compiler_command', TRIM(my_fc)) IF (FoundError(status, nf90_noerr, 539, MyFile)) THEN WRITE (stdout,50) 'compiler_command', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF IF (exit_flag.eq.NoError) THEN lstr=INDEX(my_fflags, 'free')-2 IF (lstr.le.0) lstr=LEN_TRIM(my_fflags) status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'compiler_flags', my_fflags(1:lstr)) IF (FoundError(status, nf90_noerr, 551, MyFile)) THEN WRITE (stdout,50) 'compiler_flags', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF ! ! History attribute. ! IF (exit_flag.eq.NoError) THEN IF (LEN_TRIM(date_str).gt.0) THEN WRITE (history,'(a,1x,a,", ",a)') 'ROMS/TOMS, Version', & & TRIM(version), & & TRIM(date_str) ELSE WRITE (history,'(a,1x,a)') 'ROMS/TOMS, Version', & & TRIM(version) END IF status=nf90_put_att(DAV(ng)%ncid, nf90_global, & & 'history', TRIM(history)) IF (FoundError(status, nf90_noerr, 572, MyFile)) THEN WRITE (stdout,50) 'history', TRIM(ncname) exit_flag=3 ioerror=status END IF END IF END IF ibuffer(1)=exit_flag ibuffer(2)=ioerror CALL mp_bcasti (ng, iNLM, ibuffer) exit_flag=ibuffer(1) ioerror=ibuffer(2) IF (FoundError(exit_flag, NoError, 588, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Define variables and their attributes. !----------------------------------------------------------------------- ! ! Outer and inner loop counters. ! Vinfo( 1)='outer' Vinfo( 2)='outer loop counter' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, nf90_int, & & 1, (/0/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 604, MyFile)) RETURN ! Vinfo( 1)='inner' Vinfo( 2)='inner loop counter' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, nf90_int, & & 1, (/0/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 612, MyFile)) RETURN ! ! Define model-observation comparison statistics. ! Vinfo( 1)='Nobs' Vinfo( 2)='number of observations with the same survey time' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, nf90_int, & & 1, (/surveyDim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 639, MyFile)) RETURN ! Vinfo( 1)='Nused_obs' Vinfo( 2)='Number of usable observations' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, nf90_int, & & 1, (/stateDim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 649, MyFile)) RETURN ! Vinfo( 1)='obs_mean' Vinfo( 2)='observations mean' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, (/stateDim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 657, MyFile)) RETURN ! Vinfo( 1)='obs_std' Vinfo( 2)='observations standard deviation' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, (/stateDim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 665, MyFile)) RETURN ! Vinfo( 1)='model_mean' Vinfo( 2)='model mean' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, (/stateDim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 673, MyFile)) RETURN ! Vinfo( 1)='model_std' Vinfo( 2)='model standard deviation' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, (/stateDim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 681, MyFile)) RETURN ! Vinfo( 1)='model_bias' Vinfo( 2)='model bias' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, (/stateDim/), Aval, Vinfo,ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 689, MyFile)) RETURN ! Vinfo( 1)='SDE' Vinfo( 2)='model-observations standard deviation error' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, (/stateDim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 697, MyFile)) RETURN ! Vinfo( 1)='CC' Vinfo( 2)='model-observations cross-correlation' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, (/stateDim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 705, MyFile)) RETURN ! Vinfo( 1)='MSE' Vinfo( 2)='model-observations mean squared error' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, (/stateDim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 713, MyFile)) RETURN ! ! Number of converged Ritz eigenvalues. ! Vinfo( 1)='nConvRitz' Vinfo( 2)='number of converged Ritz eigenvalues' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, nf90_int, & & 1, (/Nouterdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 737, MyFile)) RETURN ! ! Converged Ritz eigenvalues. ! Vinfo( 1)='Ritz' Vinfo( 2)='converged Ritz eigenvalues to approximate Hessian' vardim(1)=NinnerDim vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 782, MyFile)) RETURN ! ! Define conjugate gradient norm. ! Vinfo( 1)='cg_beta' Vinfo( 2)='conjugate gradient beta coefficient' vardim(1)=NinnerDimP1 vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 798, MyFile)) RETURN ! ! Define Lanczos algorithm coefficients. ! Vinfo( 1)='cg_delta' Vinfo( 2)='Lanczos algorithm delta coefficient' vardim(1)=NinnerDim vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 814, MyFile)) RETURN ! Vinfo( 1)='cg_dla' Vinfo( 2)='normalization coefficients for Lanczos vectors' vardim(1)=NinnerDim vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 828, MyFile)) RETURN ! ! Initial gradient vector normalization factor. ! Vinfo( 1)='cg_Gnorm_v' Vinfo( 2)='initial gradient normalization factor, v-space' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, (/NouterDim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 867, MyFile)) RETURN ! Vinfo( 1)='cg_Gnorm_y' Vinfo( 2)='initial gradient normalization factor, y-space' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, (/NouterDim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 875, MyFile)) RETURN ! ! Lanczos vector normalization factor. ! Vinfo( 1)='cg_QG' Vinfo( 2)='Lanczos vector normalization factor' vardim(1)=NinnerDimP1 vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 891, MyFile)) RETURN ! ! Reduction in the gradient norm. ! Vinfo( 1)='cg_Greduc_v' Vinfo( 2)='reduction in the gradient norm, v-space' vardim(1)=NinnerDim vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 923, MyFile)) RETURN ! Vinfo( 1)='cg_Greduc_y' Vinfo( 2)='reduction in the gradient norm, y-space' vardim(1)=NinnerDim vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 935, MyFile)) RETURN ! ! Eigenvalues of Lanczos recurrence relationship. ! Vinfo( 1)='cg_Ritz' Vinfo( 2)='Lanczos recurrence eigenvalues' vardim(1)=NinnerDim vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 979, MyFile)) RETURN ! ! Eigenvalues relative error. ! Vinfo( 1)='cg_RitzErr' Vinfo( 2)='Ritz eigenvalues relative error' vardim(1)=NinnerDim vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 993, MyFile)) RETURN ! ! Eigenvectors of Lanczos recurrence relationship. ! Vinfo( 1)='cg_zv' Vinfo( 2)='Lanczos recurrence eigenvectors' vardim(1)=NinnerDim vardim(2)=NinnerDim vardim(3)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 3, vardim, Aval, Vinfo, ncname, & & SetFillVal = .FALSE., & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 1027, MyFile)) RETURN ! ! Define NLM initial and final data penalty function. ! Vinfo( 1)='NL_iDataPenalty' Vinfo( 2)='nonlinear model initial data penalty function' status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, (/stateDimP1/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 1043, MyFile)) RETURN ! Vinfo( 1)='NL_fDataPenalty' Vinfo( 2)='nonlinear model final data penalty function' vardim(1)=stateDimP1 vardim(2)=NouterDim status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 1053, MyFile)) RETURN ! ! Define first guess initial data misfit. ! Vinfo( 1)='Jf' Vinfo( 2)='first guess initial data misfit' vardim(1)=NinnerDimP1 vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 1096, MyFile)) RETURN ! ! Define state estimate data misfit. ! Vinfo( 1)='Jdata' Vinfo( 2)='state estimate data misfit' vardim(1)=NinnerDimP1 vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 1110, MyFile)) RETURN ! ! Define model penalty function. ! Vinfo( 1)='Jmod' Vinfo( 2)='model penalty function' vardim(1)=NinnerDimP1 vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 1126, MyFile)) RETURN ! ! Define optimal penalty function. ! Vinfo( 1)='Jopt' Vinfo( 2)='optimal penalty function' vardim(1)=NinnerDimP1 vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 1140, MyFile)) RETURN ! ! Define actual model penalty function. ! Vinfo( 1)='Jb' Vinfo( 2)='actual model penalty function' vardim(1)=NinnerDimP1 vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 1154, MyFile)) RETURN ! ! Define actual data penalty function. ! Vinfo( 1)='Jobs' Vinfo( 2)='actual data penalty function' vardim(1)=NinnerDimP1 vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 1168, MyFile)) RETURN ! ! Define actual data penalty function. ! Vinfo( 1)='Jact' Vinfo( 2)='actual total penalty function' vardim(1)=NinnerDimP1 vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, 1182, MyFile)) RETURN ! ! Observations survey time. ! IF (find_string(var_name,n_var,Vname(1,idOday),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idOday)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1194, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idOday)) DO i=1,nvatt IF (TRIM(var_Aname(i)).eq.'long_name') THEN Vinfo(2)=TRIM(var_Achar(i)) ELSE IF (TRIM(var_Aname(i)).eq.'units') THEN Vinfo(3)=TRIM(var_Achar(i)) ELSE IF (TRIM(var_Aname(i)).eq.'calendar') THEN Vinfo(4)=TRIM(var_Achar(i)) END IF END DO status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idOday), & & NF_TOUT, 1, (/surveyDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1208, MyFile)) RETURN END IF ! ! Observation type. ! IF (find_string(var_name,n_var,Vname(1,idOtyp),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idOTyp)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1219, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idOTyp)) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idOTyp), & & nf90_int, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1224, MyFile)) RETURN ! copy attributes from observations IF (OutThread) THEN DO i=1,nvatt status=nf90_inq_attname(OBSncid, vindex, i, Aname) IF (status.eq.nf90_noerr) THEN status=nf90_copy_att(OBSncid, vindex, TRIM(Aname), & & DAV(ng)%ncid, DAV(ng)%Vid(idOTyp)) IF (FoundError(status, nf90_noerr, & & 1233, MyFile)) THEN WRITE (stdout,60) TRIM(Aname), TRIM(Vname(1,idOTyp)), & & TRIM(ncname) exit_flag=3 ioerror=status END IF ELSE WRITE (stdout,70) i, TRIM(Vname(1,idOpro)), & & TRIM(OBS(ng)%name) END IF END DO END IF ibuffer(1)=exit_flag ibuffer(2)=ioerror CALL mp_bcasti (ng, iNLM, ibuffer) exit_flag=ibuffer(1) ioerror=ibuffer(2) END IF ! ! Observations provenance. ! IF (find_string(var_name,n_var,Vname(1,idOpro),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idOpro)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1263, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idOpro)) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idOpro), & & nf90_int, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1268, MyFile)) RETURN ! copy attributes from observations IF (OutThread) THEN DO i=1,nvatt status=nf90_inq_attname(OBSncid, vindex, i, Aname) IF (status.eq.nf90_noerr) THEN status=nf90_copy_att(OBSncid, vindex, TRIM(Aname), & & DAV(ng)%ncid, DAV(ng)%Vid(idOpro)) IF (FoundError(status, nf90_noerr, & & 1277, MyFile)) THEN WRITE (stdout,60) TRIM(Aname), TRIM(Vname(1,idOpro)), & & TRIM(ncname) exit_flag=3 ioerror=status END IF ELSE WRITE (stdout,70) i, TRIM(Vname(1,idOpro)), & & TRIM(OBS(ng)%name) END IF END DO END IF ibuffer(1)=exit_flag ibuffer(2)=ioerror CALL mp_bcasti (ng, iNLM, ibuffer) exit_flag=ibuffer(1) ioerror=ibuffer(2) IF (FoundError(exit_flag, NoError, 1297, MyFile)) RETURN END IF ! ! Observations time. ! IF (find_string(var_name,n_var,Vname(1,idObsT),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idObsT)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1308, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idObsT)) DO i=1,nvatt IF (TRIM(var_Aname(i)).eq.'long_name') THEN Vinfo(2)=TRIM(var_Achar(i)) ELSE IF (TRIM(var_Aname(i)).eq.'units') THEN Vinfo(3)=TRIM(var_Achar(i)) ELSE IF (TRIM(var_Aname(i)).eq.'calendar') THEN Vinfo(4)=TRIM(var_Achar(i)) END IF END DO status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idObsT), & & NF_TOUT, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1322, MyFile)) RETURN END IF ! ! Observations longitude. ! IF (find_string(var_name,n_var,Vname(1,idOlon),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idOlon)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1333, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idOlon)) DO i=1,nvatt IF (TRIM(var_Aname(i)).eq.'long_name') THEN Vinfo(2)=TRIM(var_Achar(i)) ELSE IF (TRIM(var_Aname(i)).eq.'units') THEN Vinfo(3)=TRIM(var_Achar(i)) END IF END DO status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idOlon), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1345, MyFile)) RETURN END IF ! ! Observations latitude. ! IF (find_string(var_name,n_var,Vname(1,idOlat),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idOlat)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1356, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idOlat)) DO i=1,nvatt IF (TRIM(var_Aname(i)).eq.'long_name') THEN Vinfo(2)=TRIM(var_Achar(i)) ELSE IF (TRIM(var_Aname(i)).eq.'units') THEN Vinfo(3)=TRIM(var_Achar(i)) END IF END DO status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idOlat), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1368, MyFile)) RETURN END IF ! ! Observations depth. ! IF (find_string(var_name,n_var,Vname(1,idObsD),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idObsD)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1379, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idObsD)) DO i=1,nvatt IF (TRIM(var_Aname(i)).eq.'long_name') THEN Vinfo(2)=TRIM(var_Achar(i)) ELSE IF (TRIM(var_Aname(i)).eq.'units') THEN Vinfo(3)=TRIM(var_Achar(i)) ELSE IF (TRIM(var_Aname(i)).eq.'negative') THEN Vinfo(11)='downwards' END IF END DO Vinfo(17)='missing_value' Aval(4)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idObsD), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1395, MyFile)) RETURN END IF ! ! Observations X-fractional coordinate. ! IF (find_string(var_name,n_var,Vname(1,idObsX),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idObsX)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1406, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idObsX)) DO i=1,nvatt IF (TRIM(var_Aname(i)).eq.'long_name') THEN Vinfo(2)=TRIM(var_Achar(i)) END IF END DO status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idObsX), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1416, MyFile)) RETURN END IF ! ! Observations Y-fractional coordinate. ! IF (find_string(var_name,n_var,Vname(1,idObsY),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idObsY)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1427, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idObsY)) DO i=1,nvatt IF (TRIM(var_Aname(i)).eq.'long_name') THEN Vinfo(2)=TRIM(var_Achar(i)) END IF END DO status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idObsY), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1437, MyFile)) RETURN END IF ! ! Observations Z-fractional coordinate. ! IF (find_string(var_name,n_var,Vname(1,idObsZ),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idObsZ)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1448, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idObsZ)) DO i=1,nvatt IF (TRIM(var_Aname(i)).eq.'long_name') THEN Vinfo(2)=TRIM(var_Achar(i)) END IF END DO status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idObsZ), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1458, MyFile)) RETURN END IF ! ! Observations total error (instrument + sampling + representation). ! IF (find_string(var_name,n_var,Vname(1,idOerr),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idOerr)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1469, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idOerr)) DO i=1,nvatt IF (TRIM(var_Aname(i)).eq.'long_name') THEN Vinfo(2)=TRIM(var_Achar(i)) END IF END DO Vinfo(3)=TRIM(Vname(3,idOerr)) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idOerr), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1480, MyFile)) RETURN END IF ! ! Observations value. ! IF (find_string(var_name,n_var,Vname(1,idOval),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idOval)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1491, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idOval)) DO i=1,nvatt IF (TRIM(var_Aname(i)).eq.'long_name') THEN Vinfo(2)=TRIM(var_Achar(i)) END IF END DO Vinfo(3)=TRIM(Vname(3,idOval)) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idOval), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1502, MyFile)) RETURN END IF ! ! Observations meta value. ! IF (find_string(var_name,n_var,Vname(1,idOmet),vindex)) THEN CALL netcdf_inq_var (ng, iNLM, OBS(ng)%name, & & ncid = OBSncid, & & MyVarName = TRIM(Vname(1,idOmet)), & & nVarDim = nvdim, & & nVarAtt = nvatt) IF (FoundError(exit_flag, NoError, 1513, MyFile)) RETURN Vinfo(1)=TRIM(Vname(1,idOmet)) DO i=1,nvatt IF (TRIM(var_Aname(i)).eq.'long_name') THEN Vinfo(2)=TRIM(var_Achar(i)) END IF END DO status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idOmet), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1523, MyFile)) RETURN END IF ! ! Observations screening/normalization scale. ! Vinfo( 1)=Vname(1,idObsS) Vinfo( 2)=Vname(2,idObsS) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idObsS), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1533, MyFile)) RETURN ! ! Unvetted prior nonlinear model at observation locations. ! Vinfo( 1)=Vname(1,idNLmp) Vinfo( 2)=Vname(2,idNLmp) Vinfo( 3)=Vname(3,idNLmp) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idNLmp), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1545, MyFile)) RETURN ! ! Initial nonlinear model at observation locations. ! Vinfo( 1)=Vname(1,idNLmi) Vinfo( 2)=Vname(2,idNLmi) Vinfo( 3)=Vname(3,idNLmi) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idNLmi), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1555, MyFile)) RETURN ! ! Final nonlinear model at observation locations. ! Vinfo( 1)=Vname(1,idNLmf) Vinfo( 2)=Vname(2,idNLmf) Vinfo( 3)=Vname(3,idNLmf) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idNLmf), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1565, MyFile)) RETURN ! ! 4D-Var background error standard deviation at observation locations. ! Vinfo( 1)=Vname(1,idBgEr) Vinfo( 2)=Vname(2,idBgEr) Vinfo( 3)=Vname(3,idBgEr) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idBgEr), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1575, MyFile)) RETURN ! ! 4D-Var innovation vector: observation minus background. ! Vinfo( 1)=Vname(1,idInno) Vinfo( 2)=Vname(2,idInno) Vinfo( 3)=Vname(3,idInno) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idInno), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1585, MyFile)) RETURN ! ! 4D-Var increment vector: analysis minus background. ! Vinfo( 1)=Vname(1,idIncr) Vinfo( 2)=Vname(2,idIncr) Vinfo( 3)=Vname(3,idIncr) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idIncr), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1595, MyFile)) RETURN ! ! 4D-Var residual vector: observation minus analysis. ! Vinfo( 1)=Vname(1,idResi) Vinfo( 2)=Vname(2,idResi) Vinfo( 3)=Vname(3,idResi) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idResi), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1605, MyFile)) RETURN ! ! Unvetted nonlinear model at observation points per outer-loop. ! haveNLmod(ng)=.FALSE. Vinfo( 1)=Vname(1,idNLmu) Vinfo( 2)=Vname(2,idNLmu) Vinfo( 3)=Vname(3,idNLmu) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idNLmu), & & NF_FRST, 2, (/datumDim,NouterDim/), Aval, Vinfo, & & ncname) IF (FoundError(exit_flag, NoError, 1633, MyFile)) RETURN ! ! Nonlinear model at observation points. ! haveNLmod(ng)=.FALSE. Vinfo( 1)=Vname(1,idNLmo) Vinfo( 2)=Vname(2,idNLmo) Vinfo( 3)=Vname(3,idNLmo) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idNLmo), & & NF_FRST, 2, (/datumDim,NouterDim/), Aval, Vinfo, & & ncname) IF (FoundError(exit_flag, NoError, 1654, MyFile)) RETURN ! ! Tangent linear or representer model at observation points. ! haveTLmod(ng)=.FALSE. Vinfo( 1)=Vname(1,idTLmo) Vinfo( 2)=Vname(2,idTLmo) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idTLmo), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1674, MyFile)) RETURN ! ! Initial model-observation misfit (innovation) vector. ! Vinfo( 1)=Vname(1,idMOMi) Vinfo( 2)=Vname(2,idMOMi) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idMOMi), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1686, MyFile)) RETURN ! ! Final model-observation misfit (innovation) vector. ! Vinfo( 1)=Vname(1,idMOMf) Vinfo( 2)=Vname(2,idMOMf) status=def_var(ng, iNLM, DAV(ng)%ncid, DAV(ng)%Vid(idMOMf), & & NF_FRST, 1, (/datumDim/), Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1695, MyFile)) RETURN ! ! Define initial gradient for minimization. ! Vinfo( 1)='zgrad0' Vinfo( 2)='initial gradient for minimization, observation space' vardim(1)=datumDimP1 vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1780, MyFile)) RETURN ! ! Define initial gradient for minimization. ! Vinfo( 1)='vgrad0' Vinfo( 2)='initial gradient for minimization, v space' vardim(1)=datumDimP1 Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, vardim, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1794, MyFile)) RETURN ! ! Define sum of evolved outer-loop increments in observation space. ! Vinfo( 1)='Hbk' Vinfo( 2)='evolved sum of increments in observation space' vardim(1)=datumDim vardim(2)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1807, MyFile)) RETURN ! ! Define outer-loop background cost function. ! Vinfo( 1)='Jb0' Vinfo( 2)='Outer-loop background cost function' vardim(1)=NouterDimP1 Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 1, vardim, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1819, MyFile)) RETURN ! ! Define Lanczos vectors in observation space. ! Vinfo( 1)='vcglwk' Vinfo( 2)='Preconditioned Lanczos vectors, observation space' vardim(1)=datumDimP1 vardim(2)=NinnerDimP1 vardim(3)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 3, vardim, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1835, MyFile)) RETURN ! Vinfo( 1)='vcglev' Vinfo( 2)='converged Lanczos vectors, observation space' vardim(1)=datumDimP1 vardim(2)=NinnerDim vardim(3)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 3, vardim, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1847, MyFile)) RETURN ! Vinfo( 1)='zcglwk' Vinfo( 2)='Lanczos vectors, observation space' vardim(1)=datumDimP1 vardim(2)=NinnerDimP1 vardim(3)=NouterDim Vinfo(24)='_FillValue' Aval(6)=spval status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 3, vardim, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1859, MyFile)) RETURN ! ! Define previous values of TLmodVal. ! Vinfo( 1)='TLmodVal_S' Vinfo( 2)='tangent linear model at observation locations' vardim(1)=datumDim vardim(2)=NinnerDim vardim(3)=NouterDim status=def_var(ng, iNLM, DAV(ng)%ncid, varid, NF_FRST, & & 3, vardim, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, 1884, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Leave definition mode. !----------------------------------------------------------------------- ! CALL netcdf_enddef (ng, iNLM, ncname, DAV(ng)%ncid) IF (FoundError(exit_flag, NoError, 2104, MyFile)) RETURN ! ! Close observations NetCDF. ! IF (OBS(ng)%ncid.eq.-1) THEN CALL netcdf_close (ng, iNLM, OBSncid, OBS(ng)%name, .FALSE.) IF (FoundError(exit_flag, NoError, 2110, MyFile)) RETURN END IF END IF DEFINE ! !======================================================================= ! Open an existing model/observation file and check its contents. !======================================================================= ! QUERY : IF (.not.LdefMOD(ng)) THEN ncname=DAV(ng)%name ! ! Open model/observation for read/write. ! CALL netcdf_open (ng, iNLM, ncname, 1, DAV(ng)%ncid) IF (FoundError(exit_flag, NoError, 2124, MyFile)) THEN WRITE (stdout,30) TRIM(ncname) RETURN END IF ! ! Inquire about the dimensions and check for consistency. ! CALL netcdf_check_dim (ng, iNLM, ncname, & & ncid = DAV(ng)%ncid) IF (FoundError(exit_flag, NoError, 2133, MyFile)) RETURN ! ! Inquire about the variables. ! CALL netcdf_inq_var (ng, iNLM, ncname, & & ncid = DAV(ng)%ncid) IF (FoundError(exit_flag, NoError, 2139, MyFile)) RETURN ! ! Initialize logical switches. ! DO i=1,NV got_var(i)=.FALSE. END DO ! ! Scan variable list from model/observation NetCDF and activate ! switches for required variables. ! DO i=1,n_var IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idOday))) THEN got_var(idOday)=.TRUE. DAV(ng)%Vid(idOday)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idOTyp))) THEN got_var(idOTyp)=.TRUE. DAV(ng)%Vid(idOTyp)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idOpro))) THEN got_var(idOpro)=.TRUE. DAV(ng)%Vid(idOpro)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idObsT))) THEN got_var(idObsT)=.TRUE. DAV(ng)%Vid(idObsT)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idOlon))) THEN got_var(idOlon)=.TRUE. DAV(ng)%Vid(idOlon)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idOlat))) THEN got_var(idOlat)=.TRUE. DAV(ng)%Vid(idOlat)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idObsD))) THEN got_var(idObsD)=.TRUE. DAV(ng)%Vid(idObsD)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idObsX))) THEN got_var(idObsX)=.TRUE. DAV(ng)%Vid(idObsX)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idObsY))) THEN got_var(idObsY)=.TRUE. DAV(ng)%Vid(idObsY)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idObsZ))) THEN got_var(idObsZ)=.TRUE. DAV(ng)%Vid(idObsZ)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idOerr))) THEN got_var(idOerr)=.TRUE. DAV(ng)%Vid(idOerr)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idOval))) THEN got_var(idOval)=.TRUE. DAV(ng)%Vid(idOval)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idObsS))) THEN got_var(idObsS)=.TRUE. DAV(ng)%Vid(idObsS)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idNLmp))) THEN got_var(idNLmp)=.TRUE. DAV(ng)%Vid(idNLmp)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idNLmu))) THEN got_var(idNLmu)=.TRUE. DAV(ng)%Vid(idNLmu)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idNLmi))) THEN got_var(idNLmi)=.TRUE. DAV(ng)%Vid(idNLmi)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idNLmf))) THEN got_var(idNLmf)=.TRUE. DAV(ng)%Vid(idNLmf)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idNLmo))) THEN got_var(idNLmo)=.TRUE. haveNLmod(ng)=.TRUE. DAV(ng)%Vid(idNLmo)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idTLmo))) THEN got_var(idTLmo)=.TRUE. haveTLmod(ng)=.TRUE. DAV(ng)%Vid(idTLmo)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idBgEr))) THEN got_var(idBgEr)=.TRUE. DAV(ng)%Vid(idBgEr)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idInno))) THEN got_var(idInno)=.TRUE. DAV(ng)%Vid(idInno)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idIncr))) THEN got_var(idIncr)=.TRUE. DAV(ng)%Vid(idIncr)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idResi))) THEN got_var(idResi)=.TRUE. DAV(ng)%Vid(idResi)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idMOMi))) THEN got_var(idMOMi)=.TRUE. DAV(ng)%Vid(idMOMi)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idMOMf))) THEN got_var(idMOMf)=.TRUE. DAV(ng)%Vid(idMOMf)=var_id(i) END IF END DO ! ! Check if needed variables are available. ! IF (.not.got_var(idOday)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idOday)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idOpro)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idOpro)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idObsT)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idObsT)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idOlon)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idOlon)), & & TRIM(DAV(ng)%name) END IF IF (.not.got_var(idOlat)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idOlat)), & & TRIM(DAV(ng)%name) END IF IF (.not.got_var(idObsD)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idObsD)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idObsX)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idObsX)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idObsY)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idObsY)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idOerr)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idOerr)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idOval)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idOval)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idObsS)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idObsS)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idNLmp)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idNLmp)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idNLmu)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idNLmu)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idNLmi)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idNLmi)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idNLmf)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idNLmf)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idNLmo)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idNLmo)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idTLmo)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idTLmo)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idBgEr)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idBgEr)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idInno)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idInno)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idIncr)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idIncr)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idResi)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idResi)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idMOMi)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idMOMi)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF IF (.not.got_var(idMOMf)) THEN IF (Master) WRITE (stdout,90) TRIM(Vname(1,idMOMf)), & & TRIM(DAV(ng)%name) exit_flag=2 RETURN END IF END IF QUERY ! 10 FORMAT (/,2x,'DEF_MOD_NF90 - creating model/observation', & & ' file,',t56,'Grid ',i2.2,': ',a) 20 FORMAT (/,2x,'DEF_MOD_NF90 - inquiring model/observation', & & ' file,',t56,'Grid ',i2.2,': ',a) 30 FORMAT (/,' DEF_MOD_NF90 - unable to open observation/model', & & ' file: ',a) 40 FORMAT (/,' DEF_MOD_NF90 - unable to create model/observation', & & ' file:',1x,a) 50 FORMAT (/,' DEF_MOD_NF90 - unable to create global attribute: ', & & a,/,11x,a) 60 FORMAT (/,' DEF_MOD_NF90 - unable to copy attribute; ',a,1x, & & 'for variable: ',a,/,11x,'in file: 'a) 70 FORMAT (/,' DEF_MOD_NF90 - unable to inquire attribute ',i2.2,1x, & & 'name for variable: ',a,/,11x,'in file: 'a) 80 FORMAT (/,' DEF_MOD_NF90 - unable to copy attribute: ',1x,a,2x, & & 'for variable: ',1x,a,/,11x,a) 90 FORMAT (/,' DEF_MOD_NF90 - unable to find model/observation' & & ' variable:',1x,a,/,11x,'in file: ',a) ! RETURN END SUBROUTINE def_mod_nf90 END MODULE def_mod_mod