!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!

subroutine minpsas 1,22
  use mod4dv, only : l4dvar
  use modstag, only : lstagwinds
  use oda_shared, only : dg_ubar
  use modmask, only : lmask,lmaskto
  implicit none
  !
  !Purpose:
  !Setup of 3D/4D PSAS or OSV minimization
  !
  !Author  : S. Pellerin !ARMA/MSC  Sept, 2005
  !Revision:
  !

#include "comdim.cdk"
#include "comcva.cdk"
#include "comcst.cdk"
#include "comvfiles.cdk"
#include "comlun.cdk"
#include "comct0.cdk"
#include "comdimo.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "comoabdy.cdk"

  !
  ! Local declarations
  integer :: nl_qns(1),nl_qnwrk(5)
  real :: rl_qns(1),valfge,minfge
  real*8 :: dl_qns(1)
  integer :: nl_mode,nl_indic
  integer :: nl_err, jdata
  real*8 :: dl_j, dl_df1
  integer :: fnom,fclos
  integer :: nl_qndim,nlistele,jele
  real*8 :: dl_F
  real*8, allocatable, dimension(:) :: dl_u,dl_gradF,dl_qnwrk,dl_d
  real*8, allocatable, dimension(:) :: dl_dJdy
  integer, dimension(100) :: listele
  logical :: ll_stagwinds,flagele
  integer :: nl_stat,nl_iter, nl_sim, nl_pm1q, nl_ndata,nbrflg
  character(len=128) :: clfname

  external dscalqn, dcanonb, dcanab, simpsas
  !
  nl_ndata = count(lmask)
  nl_qndim = 4*nl_ndata + nvamaj*(2*nl_ndata + 1)
  allocate(dl_gradF(nl_ndata),dl_d(nl_ndata),dl_u(nl_ndata),dl_qnwrk(nl_qndim),dg_ubar(nl_ndata),STAT=nl_stat)

  dl_d = 0.d0
  dl_u = 0.d0
  dg_ubar = 0.d0
  dl_qnwrk = 0.d0
  dl_gradF = 0.d0

  call oda_cma2u(ncmvar,dl_d,nl_ndata)

  if (nl_stat .ne. 0) then
     write(nulout,*) 'MINPSAS: PROBLEM allocating state vectors'
     call abort3d(NULOUT,'MINPSAS: allocation problem')
  endif
  dl_F = 0.d0
  dl_gradF = 0.d0
  dl_u = 0.d0
  dg_ubar = 0.d0
  !
  nl_iter  = nitermax
  nl_sim = nsimmax
  !
  nl_mode = 0
  
  NL_INDIC =2
  if (trim(cminmode) == 'PSAS') then
     ! dl_df1 based on 3D-Var cost function (even for psas!... to investigate)
     CALL simvar(NL_INDIC,NVADIM,VAZX,DL_J,VAZG)
     DL_DF1     =  rdf1fac * ABS(DL_J)
  elseif (trim(cminmode) == 'OSV') then
     DL_DF1     =  0.01d0
  endif


  if (trim(cminmode) == 'OSV') then
     ! read djdx and assignes d=HLB(djdx) (right hand side redefined)
     CALL TRANSFER('ZGD0')
     call getdjdx ! Fill in GD
     vazx = 0.d0
     call oda_sqrtBT(vazx,nvadim) ! GD -> vazx
     call oda_sqrtB(vazx,nvadim)  ! vazx -> GD
     call oda_L ! GD -> Gomobs
     call oda_H ! Modify NCMOMA ; ncmoma=HLB(djdx); Gomobs -> OMA 
     call oda_cma2u(ncmoma,dl_u,nl_ndata) ! transfer ncmoma to dl_u
     call oda_u2cma(ncmvar,dl_u,nl_ndata) ! transfer u in ncmvar (innovation)
     dl_u = 0.d0
  endif


  if(ngrtest.ne.0) then
     call grtest2(simpsas,nulout,nl_ndata,dl_u,ngrange)
  endif

  dl_u = 0.d0
  NL_INDIC =2
  call simpsas(nl_indic,nl_ndata,dl_u,dl_F,dl_gradF)

  !     *    3. Iterations of the minimization algorithm
  !     .  ----------------------------------------
  !
  !
  !     *    .   3.2 Starting point of the minimization written to
  !     .       RPN standard output file
  !
  WRITE(NULOUT,FMT=9320)RPRECIS,DL_DF1,REPSG,NIMPRES,NITERMAX,NSIMMAX
  !
9320 FORMAT(//,10X,' Minimization starts ...',/&
          10x,'DXMIN =',G23.16,2X,'DF1 =',G23.16,2X,'EPSG =',G23.16&
          /,10X,'NIMPRES =',I3,2X,'NITER = ',I3,2X,'NSIM = ',I3,//&
          ,15X,'-STARTING POINT IS WRITTEN TO FILE ...')
  !
  !     *    .   3.3 Beginning the minimization
  !     .       --------------------------
  !
  call tmg_start(21,'QN')
  call n1qn3(simpsas, dscalqn, dcanonb, dcanab, nl_ndata, dl_u&
       ,dl_F,dl_gradF, rprecis, dl_df1, repsg, nimpres, nulout, nl_mode&
       ,nl_iter,nl_sim, nl_qnwrk, dl_qnwrk, nl_qndim, nl_qns, rl_qns&
       ,dl_qns)
  call tmg_stop (21)
  ! Change of obs state variable u to model state v
  vazx = 0.d0
  call oda_u2v(vazx,nvadim,dl_u,nl_ndata)
  !     if lrestart remain false... postmin will execute
  lrestart = .false.

  if(trim(cminmode) == 'PSAS')then
     write(nl_pm1q) nl_qnwrk,dl_qnwrk,dl_u
  elseif(trim(cminmode) == 'OSV')then
     ! Save dJ/dy = R-1/2 dJ/du
     robdata8(ncmomi,1:ndata) = 0.d0
     call oda_u2cma(ncmomi,dl_u,nl_ndata) ! transfer u in ncmomi
     call oda_sqrtRm1(ncmomi,ncmomi) ! w = R-1/2 u
     call oda_u2cma(ncmvar,dl_d,nl_ndata)
     do jdata = 1, ndata
        robdata(ncmfge,jdata) = 1.d8*robdata8(ncmomi,jdata)
     enddo
  endif

  WRITE(NULOUT,FMT=9500) nl_mode,nl_iter,nl_sim
9500 FORMAT(//,20X,20('*'),2X&
          ,/,20X,'              Minimization ended with MODE:',I4&
          ,/,20X,'          Number of iterations in this job:',I4&
          ,/,20X,'         Number of simulations in this job:',I4)

  if(l4dvar) call endsim2(nvadim,vazx)

  deallocate(dl_gradF,dl_u,dl_d,dl_qnwrk,dg_ubar,STAT=nl_stat)

  return
end subroutine minpsas