!$Id: inverse_driver.f,v 1.33 2012/08/10 22:08:22 nicolas Exp $ !$Log: inverse_driver.f,v $ !Revision 1.33 2012/08/10 22:08:22 nicolas !Update v33g: - Implementation of the L-BFGS inverse Hessian calculation ! - New cost function formulation for pseudo-obs optimization test ! (nab, 8/10/2012) ! !Revision 1.32 2012/03/01 22:00:26 daven !Submit beta_v32_026 for testing (dkh, 03/01/12) ! !Revision 1.31 2011/02/23 00:08:47 daven !UPDATES in forward model: ! - add diag59 (lz, 11/18/10) ! - GCv8-02-04: add EPA/NEI05. ! - completely update scale_anthro_mod.f to GCv9-01-01 ! - completely update epa_nei_mod.f to GCv9-01-01 ! - add nei2005_anthro_mod.f to GCv9-01-01 ! - completely update error_mod.f to GCv9-01-01 ! !BUG FIXES in forward model: ! - GCv8-02-03: Corrected_Bond_et_al_BC.2FOC_emissions ! - GCv8-02-04: Bug_fix_in_emfossil.f_for_0.5_x_0.666_nested_grid_tagged-CO_option ! - GCv8-03-02: Fix_for_EPA.2FNEI_2005_emissions ! - GCv8-03-02: Minor_fixes_in_gamap_mod.f ! - GCv9-01-01: Bug_fix_for_biofuels_in_EPA.2FNEI05 ! - GCv?-??-??: Add scaling of aromatic emissions over the US. (hotp, 11/23/09) ! - GCv9-01-01: Important_bug_fixes_for_ship_emissions ! - GCv9-01-01: Fix_to_prevent_div-by-zero_in_sulfate_mod.f ! - GCv9-01-02: Double_counting_of_biofuel_emissions_over_Asia ! - GCv9-01-02: fix SET_TINDEX for ND17, 18, 38, 39 so that all wet diagnostics get written out (dkh, 02/16/11) ! !UPDATES in adjoint model: ! - add LITR for iteration diagnostics (zhe, dkh, 02/04/11) ! - Make sure ITS_A_NEW_MONTH is true only once per month during adjoint, ! which minimized i/o. (dbm, 02/10/11) ! - now make run script copy the executable rather than move it, thus ! avoiding exessive recompilation (dbm, 02/10/11) ! - update MOPITT obs operators to support v3 and v4 (zhe, 02/04/11) ! - now add support for nested grid with offline CO (zhe, 02/04/11) ! - now emit biomass burning emissions for offline CO throughout ! the boundary layer (dbm, 02/10/11) ! - updated input.gcadj (dkh, 02/10/11) ! - better distinction between tracers and species ! - better distinction between observations and control parameters ! - additional input flags and parameters to replace hard wired options ! - ICS_SF_DEFAULT, EMS_SF_DEFAULT, EMS_ERROR, ICS_ERROR ! - LTRAJ_SCALE, LITR, NSPAN, LMAX_OBS, LEMS_ABS ! - replace OPT_THIS_SPECIES with OPT_THIS_TRACER (dkh, 02/10/11) ! - allow for flux filling during adjoint advection LFILL_ADJ (jkoo, dkh, 02/11/11) ! - add TES_BLVRM flag for tes NH3 observation (dkh, 02/14/11) ! - in lidort_mod (dkh, 01/27/11) ! - use dry diameter of BC to estimate number concentration ! - add BC mass absorption enhancement factor ABS_FAC ! - use growth curve for sulfate wet size rather than H2O from rpmares ! - implent LEMS_ABS option to output sensitivities w.r.t emissions ! rather than emissions scaling factors (dkh, 02/17/11) ! - enforce LMAX_OBS = T and NSPAN = 1 for FD_GLOB (dkh, 02/21/11) ! !BUG FIXES in adjoint model: ! - Missing a factor of 1d6 for the cspec_ppb case in CALC_ADJ_FORCE_FOR_SENSE (fgap, dkh, 02/03/11) ! - LVARTROP treated correctly (dkh, 01/26/11) ! - For LUNZIP = T, don't delete met files during forward run (zj, dkh, 07/30/10) ! - Convert units before and after transport to account for discrete <--> continuous ! adjoint (jkoo, dkh, 02/14/11) ! - Set the min value of CSPEC checkpt arrays to be SMAL2 (dkh, 02/19/11) ! - update sulfate_adj_mod to account for Fix_to_prevent_div-by-zero_in_sulfate_mod.f (dkh, 02/19/11) ! - fix the FD_SPOT test (dkh, 02/21/11) ! - now only make fdglob files if FD_GLOB, not if FD_SPOT ! - now evaluate the adjoint on 1st and 2nd iterations, and halt model if users ! asks for a third iteration in MAYBE_DO_GEOS_CHEM_ADJ ! - Force DAYS to be at least 1 to allow for simulations less than 1 day. (dkh, 02/22/11) ! !Revision 1.30 2010/11/19 07:05:24 daven !BUG FIXES: ! - fix use of ICSFD and EMSFD in SET_SF and SET_LOG_SF (lz, dkh) ! - add 0.001 to diag of S_OER in tes_o3_mod before inverting (ks,mm,dkh) ! - fix bug with concnox in partition_adj.f (jkoo) ! - implement SDFLAG flag in inverse_mod.f (zhe) !UPDATES: ! - update run script to run on prospero by default (dkh) ! - no backup ! - append iteration to ctm.bpch ! - use echo instead of ex. * ! - make sure that if LADJ = F, FD_GLOB = F (dkh) ! - update tes_nh3_mod.f (dkh) ! - update CALC_APRIORI to include option for TES_NH3_OBS (dkh) ! - update comments in adj_arrays about units of EMS_SF_ADJ and ICS_SF_ADJ (ajt) ! - add GOSAT co2 obs operator. gosat_co2_mod.f, Makefile.ifort.netcdf, adj_arrays_mod.f, ! geos_chem_adj_mod.f, input_adj_mod.f, define_adj.h (dkh) ! !Revision 1.29 2010/07/30 23:47:04 daven !Patch several bugs: ! - BUG FIX: update co2 fwd model, see Ray's email 5/18 ! - BUG FIX: enforce defualt scaling factors before using SF_tmp ! - BUF FIX: declare QTMP and FTMP thread private in fvdas_convect_adj_mod.f ! - BUG FIX: if an obs operator is defined, don't crash with No observations! ! - BUG FIX: use CHK_STT in MAKE_ADJ_FILE for scale factor instead of STT ! - BUF FIX: now declare BL_FRAC thread private in subroutine CHEM_OCPI_ADJ ! - BUF FIXES from Zhe Jiang, see email 5/17 ! - tagged_co_adj-mod.f (STT(I,J,L,1)) ! - define_adj.h (MOPITT_IR_CO_OBS) ! - mopitt_obs_mod.f (MOP_COL_GRID) ! - don't deleted unzipped met fields (geos_chem_mod) ! - reset EMS_SF_ADJ each iteration to prevent buildup !Cleanup and enhancements ! - don't need to call MAKE_PRESSURE_CHKFILE - ! - Replace CSPEC_O3_FORCE with CSPEC_ADJ_FORCE ! - remove 'ddd fwd' debug printout ! - change format line 112 in tes_nh3_mod.f to match that in tes_o3_mod.f ! - now allocate CHK_STT_BEFCHEM for LCHEM or LWETD ! - add define.h to checkpoint_mod.f in dep list makefiles !New features ! - add online LIDORT and MIE code ! !Revision 1.28 2010/05/07 20:39:47 daven !General cleanup and streamining ! - update checkpoint_mod.f to be cleaner, remove files after used ! - remove unused directories (code_adj_emis, changsub, monika) ! - update comments at top of geos_chem_adj_mod !Add stratospheric chemistry adjoint ! - add schem_adj.f and CO_strat_pl_adj.f ! - reinstate call to SCHEM in fwd model !Add CO2 adjoint ! - implement fwd model updates from Ray: ! - co2_mod.f ! - dag04_mod.f ! - gamap_mod.f ! - input_mod.f ! - logical_mod.f ! - move co2_mod to code/modified ! - update makefiles ! - add CO2 emissions IDs to adj_arrays_mod ! - add 'ppm_free_trop' as sensitivity option ! - add normalized gradients, IJ-GDEN$ !Add TES O3 obs operator ! - update Makefile.ifort.netcdf ! - add tes_o3_mod.f ! - link to LAPACK libraries ! - save strat O3 profile from SET_PROF in O3_PROF_SAV ! - always call SET_PROF in photoj.f !Update TES NH3 obs operator ! !Revision 1.27 2010/04/28 21:00:00 daven !Now support adjoint runs spanning multiple months / years (dkh, 04/28/10) ! - update ITS_A_NEW_MONTH and ITS_A_NEW_YEAR ! - move DIRECTION to time_mod.f ! !Revision 1.26 2010/04/25 17:18:58 daven !BUG FIX: correctly reset adjoints in GEOS-5 convection (dkh, 04/21/10) !BUG FIX: fix directory for cleaning *.adj.* files (jk, dkh, 04/24/10) !Now updated support for LADJ = F (dkh, 04/25/10) ! - works with X=0 and XSTOP=0 ! - updated input_adj_mod and soilnox_mod to check for LADJ ! - now use HSAVE from commode_mod instead of checkpt_mod !Now make running with LINOZE and UPBD on as the default ! !Revision 1.25 2010/04/01 07:09:43 daven !Add adjoint of deposition and emissions in gas solver (dkh, 04/01/10) ! - add calcrate_adj.f, setemis_adj.f ! - apply emission scaling factors in setemis.f, move to code/modified ! - update Makefiles * ! - add to adj_arrays_mod.f: DEPSAV_ADJ, REMIS_ADJ ! - for KPP, create DMAP to speed up calculation of V_R. Saves > 10% time. ! !Revision 1.24 2010/03/09 15:03:46 daven !General updates and fixes ! - add define.h to dep list for inverse_mod.f in Makefiles ! - GFED2 2008 monthly data is now available (gfed2_biomass_mod) ! - upgrade to the newer bpch2_mod.f from v8-02-04 ! - now only checkpt XYLAI if LCHEM in checkpt_mod (for read and write) ! - BUG FIX: correct typo in thread private pramas in SRCNH3_ADJ ! - remove obsolete 4dvar_driver.f, and references to ! - MAKE_IMIX_CHKFILE, READ_IMIX_CHKFILE ! - MAKE_FPBL_CHKFILE, READ_FPBL_CHKFILE !Now include adjoint of acetone oceean sink ! - now call OCEAN_ACET_SINK in chemistry_mod ! - now call OCEAN_ACET_SINK (self-adjoint) in chemistry_adj_mod ! - update the forward model OCEAN_ACET_SINK to be more stable and ! more precisely self-adjoint. !Now include adjoint of UPBDFLX_NOY ! - reinstate fluxes in forward model ! - add routine UPBDFLX_NOY_ADJ !Correct the following fwd model BUG FIXES from v8-02-04 ! - update reactions in sulfate_mod.f ! - Bug fix for EMEP ship emissions ! - Minor bug fix in gamap_mod.f ! - Fixes and updates in seasalt_mod.f ! - Add EFLUX to ND67 (this actually from an earlier code update) ! - Bug fix in DIAG20 (diag_pl_mod.f) ! - Div-by-zero error encountered in arsl1k.f (just update the whole file) ! - Fix for diagnostic arrays in TPCORE !Correct the following fwd model BUG FIXES from v8-02-05 ! - make STREETS thread private in READ_ANTHRO_NH3 ! - Fix for initialization of EMEP ship emissions !Now support LADJ_TRAJ diagnostic option ! - update MAKE_ADJ_FILE ! - update gamap_mod to include IJ-ADJ-$ !Now support Tagged Ox simulation (Lin Zhang et al., GRL 2009) ! - update chemistry_adj_mod.f, geos_chem_adj_mod.f, adj_arrays_mod.f, ! input_adj_mod.f, tagged_ox_mod.f, add tagged_ox_adj_mod.f ! - update Makefiles ! - treat it as an LADJ_EMS options as the sensitivities are w.r.t. sources ! - works OK but not exact yet. Still needs some debugging. ! !Revision 1.23 2010/02/10 06:25:03 daven !Updates for additional features (dkh, 02/09/10) ! - update lightning NOx with patches from 7/10/09 from v8-02-03 ! - update SO2 emissions adjoints ! - comment out IDADJ_ENOxso in adj_arrays_mod.f for now ! - now include adjoint output in tracerinfor.dat, diaginfo.dat ! - move gama_mod.f to code/modified and update makefiles ! !Revision 1.22 2010/01/28 17:37:21 daven !Update for additional emissions and a few bug fixes (dkh, 01/28/10) !- Add checkpointing to support use of MEGAN emissions ! - checkpoint T_15_AVG and T_DAY ! - move megan_mod.f to modified/ !- Add checkpointing to support use of lightning NOx emissions ! - move lightning_mod.f to modified ! - now checkpoint SLBASE ! - move lightning_mod.o to after checkpt_mod.f in Makefiles ! - take out the temp hack by Lee Murray to use specieal reprocessed OTD fields !- Turn on all the standard emissions in geos5 input.geos !- move ITS_TIME_FOR_(some met field)_ADJ functions to time_mod.f !- BUG FIX: now use NSECb from geos_chem_mod ! - always readin in met files, even if in the 'turn around' zone. !- To be safe, add some constraints on the KPP <--> SMVGEAR mapping ! of active species following recomendations of Claire Carouge !- make geos5 benchmark use Makefile.ifort instead of Makefile.ifort.netcdf !- update use of DIRECTION in chemdr_adj and chemdr.f !- decrease bufsize to 4000 in gckpp_adj_Integrator.f90 ! !Revision 1.21 2010/01/06 23:05:04 daven !Several small bug fixes and updates (dkh, 01/06/10) !- fix hardwiring of QC_SO2 allocation, should be NSTEP (mak, 11/19/09) !- read/wring XYLAI in checkpt_mod.f -- only do this for fullchem (mak, 11/19/09) !- reinstate OMP pragmas in fvdas_convect_adj_mod (mak, 12/09) !- added a prior constraint for full chem LOG_OPT (dkh, 12/14/09) !- decrease bufsize to 4000 in gckpp_adj_Integrator (dkh, 01/06/10) !- add define.h to dep list for adj_arrays_mod.f in all the Makefiles* (dkh, 01/06/10) ! !Revision 1.20 2009/11/18 07:09:33 daven !Fix several bugs in the forward model that have been found since ! the release of v8-02-01 (dkh, 11/17/09) !- apply patch for forward model bug in ! biomass_mod.f (mak, 11/17/09) !From the list of bugs fixed in v8-02-02, !http://wiki.seas.harvard.edu/geos-chem/index.php/Bugs_and_fixes !- Bug with ND52 diagnostic !- EPA/NEI inventory: reset other species to zero !- Scale factor for oceanic acetone for GEOS5 2x2.5 !- Bug with PRIVATE declaration in sulfate_mod.f !- Bug with online 2ndary aerosol (this was already fixed) !- Bug for dust in ND48 !From the list of bugs fixed in v8-02-03 !http://wiki.seas.harvard.edu/geos-chem/index.php/GEOS-Chem_v8-02-03 !- Several bug fixes in sulfate_mod.f !- Missing NOx data in S.E.-Asia !- ( Mis-calculation of Courant numbers in tpcore_fvdas_mod.f90 was ! fixed in a previous update to adjoint code ) !- Format problem in planeflight_mod.f !- Minor fixes in wet deposition !- Minor fixes for IBM XLF compiler !- Don't apply 'Minor fixes in gamap_mod.f' becuase I think they ! got it wrong (switched ALD2 with PRPE) !- Avoiding the "Too many levels in photolysis code" error !Implement newer BC/OC emissions from v8-02-02. !- add USE_BOND_BIOBURN to carbon_mod.f !- add LCOOKE to input_mod.f, logical_mod.f and switch in input.geos ! !Revision 1.19 2009/11/12 00:45:48 daven !Updates to emissions adjoints and general performance (dkh, 11/11/09) ! - Update TES NH3 ! - change to 4D Var mode instead of sensitivity forcing ! - switch to TES_v4 ! - skip a few more NT ! - now read in QFLAG, DFLAG ! - switch to TES(NT)%VAR from TES%VAR(NT) format ! - more diagnostic output, including doubled NH3 ! - Adjoint of NH3 emissions ! - Now include emission scaling factors in SRCNH3 ! - Add EMSSULFATE_ADJ ! - Add SRCNH3_ADJ ! - Update emissions adjoint IDs to ADJ_ARRAYS_MOD for fullchem ! and get rid of old hard-coded IDs. ! - BUG FIX: OBJSc should be OBJSe in Makefile.ifort and Makefile.ifort.netcdf ! - Update SET_LOG_SF to use ICS_SF_tmp and EMS_SF_tmp for PSEUDO_OBS ! - Update input_adj_mod.f to stop if using unsupported option LBKCOV (mak) ! - Cleanup and update the RESCALE and LOG_RESCALE routines. Now move ! all regularization / apriori / penalty stuff elsewhere. ! - Print NSECb to prevent corruption in LOG_OPT ! - Adjoint of BC and OC emissions ! - define ID #'s in adj_arrays_mod ! - update carbon_mod.f to include scaling factors ! - update carbon_adj_mod.f to include EMISSCARBON_ADJ and ! EMITHIGH_ADJ ! - Now include Soil NOx ! - modify soilnoxems.f to checkpt emissions and include ! scaling factors for adjoint. ! - add IDADJ_ENOxso to adj_arrays_mod.f ! - move soilnoxems.f to modified/ and update Makefiles * ! - Make DIRECTION a module variable in ADJ_ARRAYS_MOD and ! add new routines GET_DIRECTION and SET_DIRECTION ! - Add counting of active emissions for groups of species ! - Now include N_CARB_EMS_ADJ and N_SULF_EMS_ADJ ! - Now include IS_CARB_EMS_ADJ and IS_SULF_EMS_ADJ ! !Revision 1.18 2009/10/26 18:54:15 daven !BUG FIX: recalculation of isoprene emissions (dkh, 10/26/09) ! - change conditions in geos_chem_mod for determining NEW_DAY ! - now checkpoint XYLAI -- it is tricky to recalculate ! TURN CHEM BACK ON !Update TES NH3 operater (dkh, 10/26/09) ! - Add Makefile.ifort.netcdf ! - add new i/o diagnostics ! - update to v3 retrievals ! - BUG FIX: need to include define_adj.h at the top of ! geos_chem_mod.f ! - move EXPAND_NAME to adj_arrays_mod.f so that it is ! more widely accessible ! - add CMN_DEP to checkpt_mod.f in Makefiles ! - when use LIBS, take out the *.o before the -o ! - now move tes_nh3_mod to after checkpt_mod in compile list ! !Revision 1.17 2009/10/12 18:08:52 daven !Add TES NH3 operator (dkh, 10/12/09) ! - add to project and Makefiles ! - add GET_IJ to grid_mod.f !Debug and test WETDEP adjoint (dkh, 10/12/09) ! - update AD_WASHOUT to match GCv8 ! - BUG FIX: recalculate ALPHA correctly ! - BUG FIX: checkpoint MCHK values correclty at L = 1 ! - update loops in adj wetdep routines to be parallel ! - now make RAINFRAC_0 and WASHFRAC_0 local variable in ! soubroutine ADJ_SO2_WETDEP ! - declare SO2_MCHK as THREADPRIVATE in ADJ_SO2_WETDEP ! - Reset STT(SO2) and STT(SO4) at the end of DO_WETDEP_ADJ ! !Revision 1.16 2009/10/05 01:25:15 daven !Several imporant updates and fixes (dkh, mak 10/04/09) ! - Update Makefile (mak) ! - move HDF pieces to new file, Makefile.ifort.hdf ! - add ErrorModule and sciabr_co_obs_mod to Makefile.ifort ! - Now include sulfate chemistry (dkh) ! - add sulfate_adj_mod.f ! - move sulfate_mod.f to modified/ ! - remove sea salt interaction with SO4, NIT ! - add checkpointing ! - call INIT_WETSCAV_ADJ in geos_chem_adj if ! LSULF and LCHEM to allocate SO2s_ADJ and H2O2s_ADJ ! - Now include full chem wet deposition (dkh, but not tested!) ! - move wetscav_mod to /modified ! - add wetscav_adj_mod to Makefile.ifort ! - update adjoint routines ! - change ADJ_STT --> STT_ADJ ! - ADJ_SO2s, ADJ_H2O2s --> SO2s_ADJ, H2O2s_ADJ ! - change IDADJxxx --> IDTxxx ! - now just cyle past N = IDTSO2 for adjoint ! of wetdep for non-SO2 species (old method ! was to set RAINFRAC, WASHFRAC for SO2 = 0 ) ! - change LINUX_EFC --> SGI_MIPS for preproc ! directtives around the parallel do ! - BUG FIX: apply tpcore_fvdas patch, no longer need ! to set va = 0d0 (dkh) ! - keep LFILL as an argument so that we can set it to ! .FALSE. for adjoint transport. ! - Add CALC_APRIORI (mak) ! - Now get first guess of scaling factors from input.gcadj (mak) ! - Update input_adj_mod and input.gcadj to input guesses ! - Add ICS_SF_tmp and EMS_SF_tmp to ADJ_ARRAYS_MOD ! - Update SET_SF in inverse_mod ! - only apply to EMSFD or ICSFD ! - Update and fix SET_LOG_SF similarly (dkh) ! - Update the default GEOS-4 tagged CO simulation ! - 50% error for MOPITT ! - LAERO_THEM = F ! - turn on anthro emissions ! - EMEP, BRAVO, STREETS, NEI99, CAC ! !Revision 1.15 2009/09/21 01:54:19 daven !Debug GEOS-4 convection adjoint (dkh, 09/20/09) ! - remove obsolete MAKE_CONVECTION_CHKFILE from geos_chem_mod ! - BUG FIX: now use CHK_STT_CON in DO_GEOS4_CONVECT_ADJ instead of STT ! - and make the Q array REAL*4 in fvdas_convect_adj_mod ! - kludge: set N_SPEC = 1 for TAGCO sim at the top of gfed2_biomass_mod !Debug GEOS-5 advection adjoint ! - BUG FIX. During the adjoint call to GEOS-5 transport, the array "va" sometimes ! ends up with random values, say in locations like va(71,2), which are never ! inititialized or explicitly defined. Shouldn't they be defined somewhere? ! That could be a bug in fwd model... but initializing va to 0d0 at the ! start of TPCORE fixes the problem. Note that the symptom is: ! forrtl: severe (408): fort: (3): Subscript #2 of the array QQUWK has ! value -2 which is less than the lower bound of -1 !General ! - now only call DO_EMISSIONS_ADJ if LADJ_EMS ! - cleanup inverse_mod.f a bit ! - make the repository geos4 simulation a tagged CO inverse ICS test, ! while the geos5 simulation is full chem global FD test. ! - simplify INIT_WEIGHT to prevent it from crashing ! !Revision 1.14 2009/09/15 16:10:28 daven !Update input.gcadj (mak, dkh, 09/15/09) ! - now can specify IFD, JFD directly ! !Revision 1.13 2009/09/15 05:33:02 daven !Implement het chem adjoints (dkh, 09/14/09) ! - turnon CHEMCARBON in chemistry_mod.f ! - turnon CHEMCARBON_ADJ in chemistry_adj_mod.f ! - add carbon_adj_mod.f ! - move carbon_mod.f to code/modified/ and update Makefile ! - make DRYxxx public in carbon_mod !Add adjoint of aerosol thermodynamics (dkh, 09/09/09) ! - implement LAERO_THERM flag in do_chemistry and do_chemistry_adj ! - make RECOMP_RPMARES for recalculating intermediate values ! - make rpamres_adj_mod ! - make the following routine in rpmares_mod public so that ! they can be used in rpmares_adj_mod: ! - POLY4, POLY6, CUBIC, AWATER, ACTCOF !Unrelated ! - Don't stop the simulation if VAR in fwd is 1.0003d-99 and ! the recalculated value is 1.0000d-99 in CINSPECT ! !Revision 1.12 2009/09/08 04:18:25 daven !Update CO emissions adjoint (mak, dkh, 09/07/09) ! - rename tagged_adj_co_mod --> tagged_co_adj_mod ! * ( did this in Makefile, need to actually do it ) * ! - add emissions_adj_mod ! - don't recalculate forward emissions during adjoint if ! its a tagged co simulation ! - BUG_FIX: now set initial guess scaling factors to perturbed ! value every time passing through N_CALC = 1 !Add aerosol thermodynamics to forward code (dkh, 09/07/09) ! - move rmpares_mod.f to code/modified/ ! - reinstate CALL RPMARES in chemistry_mod ! - make RPAMRES_FORADJ ! !Revision 1.11 2009/09/07 20:12:47 daven !Updated convection adjoint (dkh, 08/25/09) ! - modify convection_mod.f to checkpoint arrays ! - move convection_mod.f to modified/convection_mod.f ! - delete extra copy of wetscav_mod.f in code/ ! - updated NFCLDMX_ADJ to support GEOS-5 ! !Revision 1.10 2009/08/17 03:59:52 daven !Turn on chemistry for tagged CO (dkh, 07/27/09) ! - Remove the tagged_co_mod.f file from /code, as we ! use the one in /code/modified NEED TO DO THIS ! - Remove the bpch2_mod.f file from /code, as we ! use the one in /code/modified NEED TO DO THIS ! - GEOS-5 tagged CO with chemistry turned on will ! crash if not using 72 vertical levels because the ! geos5 OH file in GEOS_MEAN hasn't been reduced ! to 30 vertical levels. So as a temporary hack, ! force the simulation to use the GEOS_4 OH fields. ! - same for GEOS-5 P/L fields ! - Add export OMP_NUM_THREADS=8 to run script ! - Add more informative printout to run script ! - Now run script checks for gctm.sf.* at the ! end of each iteration ! - Fix line overflow on 1225 of input_adj_mod.f ! - Only print out the optimizaiton header if ! ITERATE = T ! - Move call to CLEAN_FILE_DIRS to input_adj_mod ! to avoid deleting *.obs.* files for pseudo tests ! and to remove old gctm.sf.* files before calling ! ARE_FLAGS_VALID (helps inform run script of crash) ! - Now check to ensure that 1 < N_CALC < 3 for FDTEST ! in subroutine ARE_FLAGS_VALID ! - Verified FDTEST using LOG_OPT ! - implemented LOG_RESCALE for LOG_OPT, LICS ! - implemented LOG_OPT in APPLY_IC_SCALING, ! adding include define_adj.h ! - make sure call SET_LOG_SF when ! N_CALC == N_CALC_STOP == 1 ! - Use STT_ORIG in RESCALE_ADJOINT and LOG_RESCALE_ADJOINT ! rather than reading the restart file again. ! !Implement the full chem simulation (dkh, 08/16/09) ! - Update input.geos and input.gcadj ! - Update INIT_CHECKPT (use N_TRACERS instead of NOBS) ! - Remove chemistry_mod.f and chemdr.f from /code, as they ! are in /code/modified ! - Remove restart_mod.f from /code; it is in /code/modified ! - Remove physproc.f from /code; it is in /code/modified ! - Use GCKPP_ADJ_DRIVER from dkh GCv6 adjoint for both ! forward and backward integration. ! - Loop N up to N_TRACERS instead of NOBS in INIT_WEIGHT ! - Pass back the value of IERR into ISTATUS in gckpp_adj_Integartor.f90 ! - Minimal rescaling for LFDTEST or LSENS ! - IMPLEMENT OMP -- change the makefile to use parallel F90 ! compile command. ! - Take out USE GCKPP_ADJ_Model in GCKPP_ADJ_DRIVER, so reference ! everything explicitly from GCKPP_ADJ_GLOBAL ! - Add gckpp_* files to dependency list for chemistry_mod.f ! and chemistry_adj_mod.f in the Makefile.ifort ! - Update dependancy list for all gckpp_adj_* files in Makefile.ifort ! - Declare THREADPRIVATE in gckpp_adj_Global: ! - JLOOP, C, VAR, VAR_ADJ, FIX, V_CSPEC, V_CSPEC_ADJ, TIME, ! VAR_R_ADJ, RCONST ! - stack_ptr (moved here from gckpp_adj_Integrator.f90) ! - Declare THREADPRIVATE in gckpp_adj_Function: ! - A ! - Remove EQIVALENCE statment for C, VAR, FIX ! in gckpp_adj_Global. To compensate, define C ! from VAR and FIX in gckpp_adj_Initialize ! - SET VAR(15) (LISOPOH) to 1d-99. ! - Manually set VAR(13) and VAR(14) (CO2 and DRYDEP) to be zero as well. ! - Add to Makefile.ifort and CVS ! - chemdr_adj.f ! - lump_adj.f ! - partition_adj.f ! - Add INIT_KPP to gckpp_adj_Util.f90 to initialize JCOEFF. ! - Move partition.f to modified/partition.f, add PART_CASE ! - Remove CSPEC_ADJ_FOR_KPP and CSPEC_FOR_KPP_ADJ. Just use CSPEC_ADJ. ! The reason we have CSPEC_FOR_KPP is so that ! you can run KPP and SMVGEAR side-by-side in the forward model. Since ! KPP is the only way to calculate CSPEC_ADJ, don't need to make an ! extra copy. ! - Reset NEMIS and NNADDV before calling READCHEM when FIRSTCHEM in ! chemrd_adj.f. Otherwise these will get double counted, causing ! segfault crashes in calcrate. Same for NNADDA, NNADDN, NNADDC, ! NNADDD, NNADDF, NNADDH, NNADDG ! - Now use NTLOOP instead of ITLOOP when checkpointing CSPEC arrays ! - Call SAVE_FULL_TROP before GASCONC in CHEMDR_ADJ. Otherwise, CSPEC ! could get overwritten with old values in CSPEC_FULL ! - Use HSAVE (dkh) instead of HSAVE_KPP (ks) as HSAVE is set up to ! rotate and checkpt properly. ! - Now call DO_DRYDEP and DO_EMISSIONS in GEOS_CHEM_ADJ right ! before the call to adjoint of chemistry ! - Now call CINSPECT to check for consistancy between the forward ! and backward values of RCONST and VAR ! - Now save CHECK_STT_BEFCHEM before DO_EMISSIONS so that SO2, SO4 ! and DMS are correct in the adjoint gas-phase chemistry. May ! want to change this once the adjoint of the emissions ! and sulfate chemistry are in place. ! - Now call DO_PBL_MIX(.FALSE.) up top in geos_chem_adj in ! order for FPBL to be calculated for subsequent processes ! - Now save CSPEC_PRIOR the first time through gasconc so ! that partition_adj works at NHMSb (otherwise CSPEC_PRIOR ! will be zero). Make IX, IY, IZ threadprivate. ! - Can' run with soil NOx on yet until we make it recalculate ! emissions in adj mode. Disable it for now. ! - Reinstate CALL OPTDEPTH in DO_CHEMISTRY_ADJ so that ! photolysis rates get recalculated correctly ! !Revision 1.9 2009/07/14 23:51:27 daven !Updated to run with GEOS-5 and PBL mixing (dkh, 07/14/09) ! - add support for GEOS-5 ! - if using GEOS-5, make sure that IN_CLOUD_OD is defined in define.h ! - update GET_A3_TIME_ADJ to treat GEOS_5 the same as GEOS_4 ! - implement printout for GEOS_5 in DISPLAY_MET ! - turn on LNEI99 (or else the code bombs when trying to access USA_MASK ! which is not allocated). This is a bug in the standard forward code. ! - move call to CALC_ADJ_FORCE to after interpolation of the I-6 fields ! - add constraint for FDTEST in ITS_TIME_FOR_OBS that it must be a TS_CHEM ! - implement TURBDAY_ADJ, now recalculate IMIX and FPBL rather than checkpoint ! - this means atting GET_IMIX and GET_FPBL to pbs_mix_mod ! - modify adjoint code to reference these routines ! - remove unused stuff for checkpointing ! - remove old CLEANUP_PBL_MIX_ADJ from cleanup and cleanup_adj ! - apply FD diff to ICSFD in SET_SF_FORFD, FD_SPOT, LICS ! - ensure that UNITS of COST_FUNC are the default for FD_GLOB ! !Revision 1.8 2009/06/26 03:57:58 daven !Updated, CO FD_GLOB LICS now works w/o any processes (dkh, 06/25/09) ! - remove ctm.bpch and geos from repository to speedup ! checkout ! - have gctm.model.* gctm.costfn* and gctm.obs* be written ! to DIAGADJ_DIR instead of OPT_DIR ! - Take out the LADJ_TRAN flag. Would this ever ! differ from LTRAN? ! - Now for FDTEST force FLAG to TRUE on the first attempt during ! the adjoint integration and false otherwise. ! - clean out old *.fd.* files on N_CALC == 1 ! - replace restart file with Monikas from 20040501 ! - add ICSFD. This selects the denominator of the sensitivities ! for an initial conditions finite difference test independently ! of the species being included in the numerator. ! - add more comments to FD menu in input.gcadj, swap order of ! NFD and MFD. move FD_SPOT and FD_GLOB to FD menu, and ! move definition of MMSCL to control variables menu ! - uypdate ARE_FLAGS_VALID to be more rigorous ! - make sure LADJ_CHEM and LCHEM match ! - make sure 1 and only 1 type of simulation selected ! - make sure some obs are selected for 3D or 4DVar ! - make sure no obs are selected for FDTEST ! - make sure that 1 and only 1 of LADJ_EMS and LICS ! is included for FDTEST ! - Re-reading the restart file gave negative STT values. Instead, ! let's go back to using STT_ORIG. ! - fixed inconsistancies in lots of preprocessor tags: ! MOPITT_OBS --> MOPITT_IR_CO_OBS ! O3_ATTAINMENT --> SOMO35_ATTAINMENT ! CASTNET_OBS --> CASTNET_NH4_OBS ! IMPROVE_OBS --> IMPROVE_SO4_NIT_OBS ! - don't leave PSEUDO_OBS on by default, as it can mess up an FD test ! - add define_adj.h to dep list in Makefile.ifort for ! - adj_arrays_mod.o ! - input_adj_mod.o ! - inverse_driver.o ! - geos_chem_mod.o ! - in input_mod.f, make sure that TS_DYN always stays the same ! value regardless of which processes are turned on or off. ! Move this file to code/modified and update Makefile accordingly ! !Revision 1.7 2009/06/23 06:47:07 daven !Updates (mak, dkh, 06/23/09) ! - move tagged_co_mod from code/modified/monika to ! code/modified (mak) ! - add background error (mak, untested) ! - reinstate LDEL_CHKPT flag (dkh) ! - update CO obs operator defs in define_adj.h (mak) ! - distinguish between LEMS and LADJ_EMS (mak) ! - added CO diagnostics (mak) ! - updated Makefile, but still mostly commented out (mak) ! !Revision 1.6 2009/06/19 07:05:23 daven !Updates (mak, dkh, 06/19/09) ! - switch the test simulation to ! - 4DVar ! - use a real restart file ! - not LOG_OPT in define_adj.h ! - 30 levels (in define.h ! - change flags in input.gcadj ! - turn off biogenic emissions in input.geos ! - add LADJ_EMS flag to many places ! - add RESCALE routine in geos_chem_adj_mod ! - now call INIT_WEIGHT at the beginning of ! geos_chem_adj_mod ! !Revision 1.5 2009/06/17 07:39:04 daven !Update met field i/o for GEOS_4 adj integration (dkh, 06/17/09) ! - decrement adjoint time before reading checkpt files ! - update routines in i6_read_mod, dao_mod ! - add SLP_TMP, LWI_TMP, TO3_TMP and TTO3_TMP ! - test w/ and /wo transport on. Adjust call to INTERP ! accordingly. ! - add dependencies to geos_chem_mod in Makefile ! - move get_read_mod.f to modified/ ! !Revision 1.4 2009/06/15 06:44:12 daven !Updates (dkh, 06/15/09) ! - New Makefile layout with folders and dependency (ks) ! - move calcrate.f to modified (ks) ! - update transport_mod (ks) ! - add run script to run directory (dkh) ! ! PROGRAM INVERSE ! !***************************************************************************************** ! Program inverse is the master driver for the inverse and adjoint modeling capabilities ! of the GEOS-Chem chemical transport model. (dkh, ks, mak, cs 06/07/09) ! ! NOTES ! (1 ) Add support for inverse Hessian LINVH (dkh, 01/13/12, adj32_012) ! (2 ) Add support for strat fluxes LADJ_STRAT (hml, dkh, 02/15/12, adj32_055) ! (3 ) Add support for inverse Hessian LINVH_BFGS (nab, 03/25/12 ) !***************************************************************************************** ! ! Reference to f90 modules USE A3_READ_MOD, ONLY : UNZIP_A3_FIELDS USE A6_READ_MOD, ONLY : UNZIP_A6_FIELDS USE ADJ_ARRAYS_MOD, ONLY : COST_FUNC USE ADJ_ARRAYS_MOD, ONLY : N_CALC USE ADJ_ARRAYS_MOD, ONLY : N_CALC_STOP USE ADJ_ARRAYS_MOD, ONLY : N_CALC_TOTAL USE ADJ_ARRAYS_MOD, ONLY : NOPT, IFD, JFD, LFD, MFD USE ADJ_ARRAYS_MOD, ONLY : NFD,EMSFD USE ADJ_ARRAYS_MOD, ONLY : STT_ADJ_FD, EMS_SF_ADJ,ICS_SF_ADJ USE ADJ_ARRAYS_MOD, ONLY : INIT_ADJ_ARRAYS USE ADJ_ARRAYS_MOD, ONLY : COST_FUNC_SAV USE ADJ_ARRAYS_MOD, ONLY : LOSS_SF_ADJ USE ADJ_ARRAYS_MOD, ONLY : STRFD USE ADJ_ARRAYS_MOD, ONLY : RATE_SF_ADJ USE ADJ_ARRAYS_MOD, ONLY : RATFD USE CHECKPT_MOD, ONLY : MAKE_EMS_ADJ_FILE USE ERROR_MOD, ONLY : DEBUG_MSG USE FILE_MOD, ONLY : CLOSE_FILES USE GEOS_CHEM_MOD, ONLY : DO_GEOS_CHEM USE GEOS_CHEM_ADJ_MOD, ONLY : DO_GEOS_CHEM_ADJ USE GWET_READ_MOD, ONLY : UNZIP_GWET_FIELDS USE I6_READ_MOD, ONLY : UNZIP_I6_FIELDS USE INPUT_MOD, ONLY : READ_INPUT_FILE USE INPUT_ADJ_MOD, ONLY : READ_INPUT_ADJ_FILE USE INV_HESSIAN_MOD, ONLY : UPDATE_HESSIAN USE INVERSE_MOD, ONLY : SET_SF, SET_LOG_SF USE INVERSE_MOD, ONLY : SET_SF_FORFD USE INVERSE_MOD, ONLY : MAKE_SF_FILE USE INVERSE_MOD, ONLY : MAKE_GDT_FILE USE INVERSE_MOD, ONLY : MAKE_CFN_FILE USE INVERSE_MOD, ONLY : READ_GDT_FILE USE INVERSE_MOD, ONLY : READ_CFN_FILE USE INVERSE_MOD, ONLY : SET_OPT_RANGE USE INVERSE_MOD, ONLY : INIT_INVERSE USE INVERSE_MOD, ONLY : GET_X_FROM_SF USE INVERSE_MOD, ONLY : GET_SF_FROM_X USE INVERSE_MOD, ONLY : GET_GRADNT_FROM_ADJ USE INVERSE_MOD, ONLY : X USE INVERSE_MOD, ONLY : GRADNT USE INVERSE_MOD, ONLY : CALC_NOPT USE INVERSE_MOD, ONLY : DISPLAY_STUFF USE INVERSE_MOD, ONLY : MAKE_SAT_DIAG_FILE USE INVERSE_MOD, ONLY : ITER_CONDITION USE INVERSE_MOD, ONLY : MAYBE_DO_GEOS_CHEM_ADJ USE LOGICAL_MOD, ONLY : LPRT USE LOGICAL_MOD, ONLY : LUNZIP USE LOGICAL_ADJ_MOD, ONLY : LFDTEST USE LOGICAL_ADJ_MOD, ONLY : LINVH,LINVH_BFGS USE LOGICAL_ADJ_MOD, ONLY : LADJ USE LOGICAL_ADJ_MOD, ONLY : LADJ_EMS USE LOGICAL_ADJ_MOD, ONLY : LICS USE LOGICAL_ADJ_MOD, ONLY : LDCOSAT USE LOGICAL_ADJ_MOD, ONLY : LATF USE LOGICAL_ADJ_MOD, ONLY : LITR USE LOGICAL_ADJ_MOD, ONLY : LEMS_ABS USE LOGICAL_ADJ_MOD, ONLY : LADJ_STRAT USE LOGICAL_ADJ_MOD, ONLY : LADJ_RRATE !USE PHIS_READ_MOD, ONLY : UNZIP_PHIS_FIELD # include "define_adj.h" #if defined ( LBFGS_INV ) USE INV_HESSIAN_LBFGS_MOD, ONLY : LBFGS_INV_HESSIAN #endif ! Force all variables to be declared explicitly IMPLICIT NONE ! Program variables LOGICAL :: ITERATE = .TRUE. ! Variables and parameters for optimization -- see setulb.f for ! definitions of these. INTEGER :: iprint, isave(44) CHARACTER*60 :: task, csave DOUBLE PRECISION :: factr, pgtol, dsave(29) DOUBLE PRECISION :: F LOGICAL :: lsave(4) INTEGER, PARAMETER :: MMAX = 17 INTEGER :: LENWA INTEGER, ALLOCATABLE :: nbd(:) INTEGER, ALLOCATABLE :: iwa(:) REAL*8, ALLOCATABLE :: llim(:) REAL*8, ALLOCATABLE :: u(:) REAL*8, ALLOCATABLE :: wa(:) INTEGER :: IOPT,MM !================================================================= ! INVERSE starts here! !================================================================= ! Read forward model input file and call init routines from ! other modules CALL READ_INPUT_FILE IF ( LPRT ) CALL DEBUG_MSG( '### INVERSE: a READ_INPUT_FILE' ) ! Read final iteration number from file OPEN( 65, file = 'ITER' ) READ( 65,*) N_CALC_STOP READ ( 65,*) N_CALC_TOTAL CLOSE( 65 ) !Number of previous iterations used in the Hessian approximation !Here it was set to the total number of iteration !=>Memory problem for big control vector so set back to MM = 5 ! MM = N_CALC_TOTAL MM = 5 ! Read input file for adjoint model CALL READ_INPUT_ADJ_FILE ! Initialize arrays for optimization IF (LADJ) CALL INIT_SETULB ! Initialize inverse modeling module CALL INIT_INVERSE ! Curent iteration N_CALC = 0 ! Initialize adjoint arrays ! some arrays still need to be initialized CALL INIT_ADJ_ARRAYS IF ( LPRT ) CALL DEBUG_MSG( '### INVERSE: a INIT_ADJ_ARRAYS' ) ! Now do this in input_adj_mod.f (dkh, 07/28/09) !! Clean out file directories (rm *.chk.* , *.adj.* , *.ics.* and !! *.gdt.* files ) !CALL CLEAN_FILE_DIRS !================================================================= ! ***** R E F E R E N C E C A L C U L A T I O N ***** ! for generating pseudo observations !================================================================= IF ( N_CALC_STOP == 0 ) THEN ! Now only call this once above (dkh, 07/27/09) !! Remove files from previous runs !CALL CLEAN_FILE_DIRS ! Set IC's to their reference values #if defined ( LOG_OPT ) CALL SET_LOG_SF #else CALL SET_SF #endif ! Call GEOS-CHEM CALL DO_GEOS_CHEM ! Make SF file CALL MAKE_SF_FILE ! EXIT ITERATE = .FALSE. ENDIF ! Allow for use of this driver to run only the forward model as ! a reference calculation. IF ( .not. LADJ ) ITERATE = .FALSE. !================================================================= ! ***** S E T S C A L I N G F A C T O R S ***** !================================================================= ! Now only call this once above (dkh, 07/27/09) !! this call was deleting obs files! need to either delete it or !! replace some options inside (mak, 6/18/09) !CALL CLEAN_FILE_DIRS ! Perturb the initial conditions IF ( ITERATE ) THEN #if defined ( LOG_OPT ) CALL SET_LOG_SF #else CALL SET_SF #endif ENDIF ! if LINVH_BFGS directly compute the L-BFGS inverse Hessian ! (nab, 03/27/12) #if defined ( LBFGS_INV ) IF ( .NOT. ( LINVH_BFGS ) ) THEN #endif !================================================================= ! ***** O P T I M I Z A T I O N ***** !================================================================= ! Set parameters for optimization. See setulb.f for definitions. ! Let PGTOL be very small for FDTEST, as we're not actually doing ! an optimization in this case. IPRINT = 1 FACTR = 1.0D01 IF ( LFDTEST ) THEN PGTOL = 1.0D-12 ELSE PGTOL = 1.0D-05 ENDIF #if defined ( LOG_OPT ) DO IOPT = 1, NOPT NBD(IOPT) = 0 ! 0 = no bounds ENDDO #else DO IOPT = 1, NOPT NBD(IOPT) = 1 LLIM(IOPT) = 0.0D0 ENDDO #endif task = 'START' ! Mare array of scaling factors into a vector for optimization CALL GET_X_FROM_SF !================================================================= ! OPTIMIZATION loop starts here! !================================================================= IF ( ITERATE ) THEN ! Echo some input to the screen WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, '(a,/)' ) 'S T A R T O P T I M I Z A T I O N' WRITE (6,16) 16 format(/ 5x, 'Solving GEOS-Chem Adjoint.' + / 5x, ' (f = 0.0 at the optimal solution.)' /) ENDIF ! Beginning of the loop DO WHILE( ITERATE ) print*, ' do setulb ' ! Call the L-BFGS-code CALL SETULB( NOPT, MM, X, LLIM, U, NBD, & F, GRADNT, FACTR, PGTOL, WA, IWA, & TASK, IPRINT, CSAVE, LSAVE, ISAVE, DSAVE ) print*, ' done setulb ' , TASK(1:2) ! Force it to continue for FD tests, as cost func or gradients ! may be very small or zero (dkh, 02/11/11) IF ( LFDTEST ) TASK(1:2) = 'FG' IF ( TASK(1:2) == 'FG' ) THEN ! Iteration diagnostics (zhe 11/28/10) IF ( LITR ) THEN IF ( N_CALC .GT. 0 ) CALL ITER_CONDITION( N_CALC ) LATF = .FALSE. ENDIF ! The minimization routine has returned to request the ! function f and gradient g values at the current x ! Update iteration count N_CALC = N_CALC + 1 ! Resent cost function for this iteration COST_FUNC = 0.D0 IF ( N_CALC < N_CALC_STOP ) THEN WRITE(6,*) 'READING SAVED DATA for N_CALC = ', N_CALC ! Read scaling factor values from disk CALL GET_SF_FROM_X CALL DISPLAY_STUFF( 1 ) ! Read gradients from disk CALL READ_GDT_FILE ! Read cost function from disk CALL READ_CFN_FILE ! Put adjoints into GRADNT vector CALL GET_GRADNT_FROM_ADJ !Save the current adjoint in the finite difference test cell ! Initial conditions test IF ( LFDTEST .AND. LICS .AND. LADJ_EMS) THEN PRINT*, 'WE HAVE A PROBLEM WITH STT_ADJ_FD when LICS & & LADJ_EMS are both TRUE' ELSEIF ( LFDTEST .AND. LICS ) THEN STT_ADJ_FD(N_CALC) = ICS_SF_ADJ(IFD,JFD,LFD,NFD) ELSEIF ( LFDTEST .AND. LADJ_EMS ) THEN ! Emissions test IF ( .NOT. LADJ_STRAT .AND. .NOT. LADJ_RRATE ) THEN STT_ADJ_FD(N_CALC) = EMS_SF_ADJ(IFD,JFD,MFD,EMSFD) ! Strat prod and loss sense (hml, adj32_025) !ELSEIF ( LADJ_STRAT ) THEN ELSEIF ( LADJ_STRAT .AND. .NOT. LADJ_RRATE ) THEN STT_ADJ_FD(N_CALC) = LOSS_SF_ADJ & (IFD,JFD,MFD,STRFD) ! Reaction rate (tww, 05/15/12) ELSEIF ( LADJ_RRATE ) THEN STT_ADJ_FD(N_CALC) = RATE_SF_ADJ & (IFD,JFD,LFD,RATFD) ENDIF ENDIF ! Copy value of COST_FUNC to the optimization variable F F = COST_FUNC ! Save current cost function COST_FUNC_SAV(N_CALC) = COST_FUNC CALL DISPLAY_STUFF( 2 ) ! to estimate inverse Hessian (offline) (dkh, 01/12/12, adj32_012) IF ( N_CALC == 1 .and. LINVH ) CALL UPDATE_HESSIAN ! Return to beginning of loop ELSEIF ( N_CALC == N_CALC_STOP ) THEN ! Done if we are just estimating inverse Hessian (dkh, 01/12/12, adj32_012) IF ( LINVH ) THEN WRITE(6,*) ' Force quit' STOP ENDIF ! UPDATE THE INITIAL CONDITIONS ! If we're doing a finite difference test, reset to the orginal ! SF and augment by amount FD_DIFF. Don't use X in this case. ! old: !IF ( ACTIVE_VARS == 'FDTEST' .AND. N_CALC == 2 ) THEN ! new: now support 2nd order FDTEST (MAKE_SAVE_FILE_2) IF ( LFDTEST .AND. N_CALC > 1 ) THEN CALL SET_SF_FORFD ELSEIF ( N_CALC == 1 ) THEN ! don't need to call this again ?? !CALL SET_SF #if defined ( LOG_OPT ) CALL SET_LOG_SF #else CALL SET_SF #endif ELSE ! Update the scaling factors to the current X CALL GET_SF_FROM_X ENDIF CALL DISPLAY_STUFF( 3 ) !============================================================== ! OPTIONAL: uncomment to use scaling factors from another run !============================================================== !CALL READ_SF_FILE !============================================================== ! FORWARD RUN !============================================================== CALL DO_GEOS_CHEM !============================================================== ! ADJOINT CALCULATION !============================================================== IF ( .not. LFDTEST ) THEN CALL DO_GEOS_CHEM_ADJ ! For finite difference test, we may or may not do adjoint ELSE CALL MAYBE_DO_GEOS_CHEM_ADJ ENDIF !============================================================== ! SAVE RESULTS TO DISK and EXIT OPTIMIZATION LOOP !============================================================== ! Zero the gradients of the species that we do not wish to optimize ! or in places that you don't want optimized CALL SET_OPT_RANGE ! Add to this Kumaresh's spatial filter ! Write gradients CALL MAKE_GDT_FILE ! Write scaling factors CALL MAKE_SF_FILE ! Write cost function CALL MAKE_CFN_FILE !============================================================== ! Diagnostics !================================================= ! store satellite diagnostics ! for now CO, but subroutines all general, just need linking ! (mak 6/19/09) IF ( LDCOSAT ) THEN !Store FORCING, MOP_MOD_DIFF and MODEL_BIAS !CALL MAKE_FORCING_FILE !CALL MAKE_MOPMOD_FILE ! store model, mopitt and model bias to files ! model CALL MAKE_SAT_DIAG_FILE( 1 ) ! obs and DOFs IF( N_CALC_STOP == 1) THEN CALL MAKE_SAT_DIAG_FILE( 2 ) ENDIF CALL MAKE_SAT_DIAG_FILE( 6 ) CALL MAKE_SAT_DIAG_FILE( 7 ) ! model bias (wrt satellite data) CALL MAKE_SAT_DIAG_FILE( 3 ) ! store COST_ARRAY, OBS_COUNT, OBS_HOUR* CALL MAKE_SAT_DIAG_FILE( 5 ) ENDIF IF ( LEMS_ABS ) CALL MAKE_EMS_ADJ_FILE ! Write results to screen CALL DISPLAY_STUFF( 4 ) ! Exit loop ITERATE = .FALSE. ENDIF ELSEIF ( TASK(1:5) == 'NEW_X' ) THEN ! The minimization routine has returned with a new iterate, ! and we have opted to continue the interation ! Update the inverse hessian approximation (dkh, 01/12/12, adj32_012) IF ( LINVH ) THEN CALL UPDATE_HESSIAN ENDIF ELSE ! We terminate execution when TASK is neither FG nor NEW_X. ! We print the information contained in the string TASK ! if the default output is not used and the execution is ! not stopped intentionally by the user. IF ( IPRINT == -1 .AND. TASK(1:4) /= 'STOP' ) & WRITE(6,*) TASK WRITE(6,*) TASK ! Exit loop ITERATE = .FALSE. ENDIF !================================================================= ! OPTIMIZATION loop ends here! !================================================================= ENDDO WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, '(a,/)' ) 'F I N I S H I T E R A T I O N ' #if defined ( LBFGS_INV ) ENDIF ! end Hessian BFGS condition (nab) ! Calculate the (diagonal) inverse Hessian approximation ! Using the L-BFGS algorithm ( nab, 24/03/12 ) IF ( ( LINVH_BFGS ) & .AND. ( N_CALC_TOTAL .GE. 2 ) ) THEN N_CALC = N_CALC_TOTAL PRINT*,'***********************************************' PRINT*,'C O M P U T E E S T I M A T I O N E R R O R' PRINT*,'***********************************************' CALL LBFGS_INV_HESSIAN(MM) ENDIF #endif ! Clean up and quit CALL CLOSE_FILES CALL CLEANUP CALL CLEANUP_ADJ ! Remove all met files from temporary directory IF ( LUNZIP ) THEN CALL UNZIP_A3_FIELDS( 'remove all' ) CALL UNZIP_A6_FIELDS( 'remove all' ) CALL UNZIP_I6_FIELDS( 'remove all' ) !CALL UNZIP_PHIS_FIELD( 'remove all' ) #if defined( GEOS_3 ) ! We only need to remove the GWET fields if we are ! using the online dust simulation (bmy, 4/1/04) IF ( LDUST ) THEN CALL UNZIP_GWET_FIELDS( 'remove all' ) ENDIF #endif ENDIF ! Write the final iteration number for the next iteration to file OPEN( 65, file = 'ITER' ) WRITE( 65,*) N_CALC_STOP + 1 CLOSE( 65 ) WRITE( 6, '(a,/)' ) 'D O N E' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) CONTAINS !------------------------------------------------------------------------------ SUBROUTINE INIT_SETULB( ) ! !****************************************************************************** ! Subroutine INIT_SETULB initializes arrays used by the optimization routine, ! setulb, whose size depends upon the model simulation type and resolution. ! (dkh, 06/07/09) ! ! NOTES: ! !****************************************************************************** ! ! Reference to f90 modules USE ADJ_ARRAYS_MOD, ONLY : NOPT USE ERROR_MOD, ONLY : ALLOC_ERR USE INVERSE_MOD, ONLY : CALC_NOPT ! Local variables INTEGER :: AS !================================================================= ! INIT_SETULB begins here! !================================================================= ! Calculate the maximum number of control parameters that could ! be optimized, NOPT CALL CALC_NOPT LENWA = 2 * MM * NOPT + 5 * NOPT + 11 * MM * MM + 8 * MM ALLOCATE( NBD( NOPT ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'NBD' ) !NBD = 0 ALLOCATE( IWA( 3*NOPT ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'IWA' ) IWA = 0 ALLOCATE( LLIM( NOPT ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'LLIM' ) ! Don't set default bounds (dkh, 11/07/09) !LLIM = 0 ALLOCATE( U( NOPT ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'LLIM' ) ! Don't set default bounds (dkh, 11/07/09) !U = 0 ALLOCATE( WA( LENWA ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'WA' ) WA = 0 ! Return to calling program END SUBROUTINE INIT_SETULB !------------------------------------------------------------------------------ END PROGRAM INVERSE