! $Id: teq.f90,v 1.2 2007/07/23 16:00:58 meyer Exp $

MODULE teq_input_mod

  USE sep_math

  INTEGER,  POINTER :: t_lsrf,t_lelm,t_lflat,t_ifluxcord,t_nsym,&
       t_entropy_flag,t_filter_wp,t_filter_p,t_one_pow,t_mdpsi,t_ipp,t_ipf,&
       t_ipj,t_kedge,t_ircwt,t_bsph_flag,t_inv_eq,t_map,t_lhalo,t_lmax,&
       t_nprt59,t_npoly,t_logunit,t_jm,t_km,t_jmkm,t_mls,t_msrf,t_n4,t_n6,&
       t_nplates,t_nsegs,t_nsymo,t_ncallsf
  REAL(rq), POINTER :: t_btor,t_plcm,t_dphi00,t_dpsi00,t_splbdry,t_betaj,&
       t_qcelm,t_pcelm,t_scelm,t_qflat,t_qrat,t_scflat,t_prsx,t_psilm,t_aap,&
       t_nasp,t_nbsp,t_gsph,t_psph,t_xsph,t_epf,t_epp,t_npf,t_npp,t_psil,&
       t_psix,t_raxis,t_zaxis,t_alphac,t_alpha,t_gammac,t_deltac,t_delta,&
       t_deltadc,t_deltad,t_sigmac,t_sigma,t_tauc,t_thetac,t_theta,t_wvert,&
       t_ro,t_dr,t_dz,t_hsrf,t_rcur,t_zcur,t_plcm_gun,t_f_gun0,t_rn,t_rx,t_zn,&
       t_zx,t_m95,t_dn_criterion,t_spt_angle
  REAL(rq), DIMENSION(:), POINTER :: t_alfa,t_betp,t_asph,t_bsph,t_pefit,&
       t_fefit,t_rzsph,t_rxpr,t_zxpr,t_rapr,t_zapr,t_qsave,t_jtsave,&
       t_jparsave,t_ssave,t_psave,t_fsave,t_w,t_v,t_r,t_z,t_rwl,t_rwu,t_psi,&
       t_rls,t_zls
  REAL(rq), DIMENSION(:,:), POINTER :: t_rplate,t_zplate
  INTEGER,  DIMENSION(:), POINTER :: t_jwl,t_jwu
  LOGICAL,  POINTER :: t_fix_bound,t_use_halo

END MODULE teq_input_mod

MODULE teq_output_mod
  USE sep_math
  REAL(rq), TARGET :: t_rxpf,t_zxpf,t_rxpt,t_zxpt,t_pxpt,t_psih,t_dpsi0,&
       t_dphi0,t_fwall,t_plc,t_lamdagun,t_rgun=0,t_zgun,t_fgun,t_residj,&
       t_vltsnd(3),t_li(3),t_betap(3),t_betaps(3),t_lam(3),t_rstkpt(4),&
       t_zstkpt(4),t_dstkpt(4),t_bstkpt(4),t_rspt(4),t_zspt(4),&
       t_dspt(4),t_bspt(4),t_betae,t_betat,t_flxln,t_absflx,t_psisep,t_psipls,&
       t_helicity,t_xindf,t_slfnd,t_xlfnd,t_volume,t_surf,t_ctroy,t_qmerc,&
       t_placur,t_elongn,t_trianu,t_trianl,t_trian,t_t95,t_tl95,t_tu95,&
       t_trider,t_f95,t_p95,t_psi95,t_e95,t_q95,t_qmin,t_rhomin,t_qstar,&
       t_aspct,t_wpf,t_wpt,t_al,t_bpsqva,t_presva,t_pressa,t_betal,t_bpolsa,&
       t_ccdir
  INTEGER, TARGET :: t_nitt,t_nspt,t_nstkpts
  REAL(rq), DIMENSION(:), ALLOCATABLE, TARGET :: t_frsrf,t_fpsrf,t_qsrf,&
       t_rsqbp,t_jtsrf,t_rsqrf,t_rsqirf,t_jparsrf,t_susrf,t_cusrf,t_vpsrf,&
       t_srsrf,t_prsrf,t_pdsrf,t_rsrf,t_asrf,t_volsrf,t_qh,t_bsqrf,t_esrf,&
       t_tsrf,t_bpsrf,t_alsrf,t_risrf,t_psibar,t_phibar,t_psrf,t_vptor,&
       t_psiinv,t_psidinv,t_rhosrf,t_psidbar,t_rlimw,t_zlimw,t_tlimw,&
       t_plimw,t_crj,t_br,t_bz,t_bp,t_bt,t_bmod,t_pvec,t_psiw,t_tswpts,&
       t_tlsrf,t_tusrf,t_fldind,t_fttcsrf,t_brwpts,t_bzwpts
  INTEGER, DIMENSION(4), TARGET :: t_lstkpt(4)
  REAL(rq), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: t_rlsd,t_zlsd

END MODULE teq_output_mod

MODULE teq_mod
  USE teq_input_mod
  USE teq_output_mod
  USE sep_separatrix
  REAL(rq), DIMENSION(:), ALLOCATABLE, TARGET :: t_c1srf,t_c4srf,t_c5srf,&
       t_r2bzrf,t_r4bp2rf,t_rm,t_zm,t_clj,t_psi00,t_psi01
  REAL(rq), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_pdls,t_mpoly,t_dpoly,&
       t_spoly,t_mpoli,t_dpoli,t_spoli,t_thhsrf
  REAL(rq), DIMENSION(:,:,:), POINTER ::t_rhosq
  INTEGER,  DIMENSION(:,:), ALLOCATABLE, TARGET :: t_lhsrf
  INTEGER, TARGET :: ioun7,ioun12,ioun13
  INTEGER, POINTER :: t_nprob
  REAL(rq), POINTER :: t_shotTime
  CHARACTER(len=16), POINTER :: t_shotName,t_site
  CHARACTER(len=80), POINTER :: t_note
  CHARACTER(len=40), POINTER :: t_probid,t_theader
  CHARACTER(len=8),  POINTER :: t_rundate,t_runtime,t_codetime
  CHARACTER(len=10), POINTER :: t_codedate
  CHARACTER(len=64), POINTER :: t_logname
  CHARACTER(len=3),  POINTER :: t_pkgname
  CHARACTER(len=48), POINTER :: t_gheader
  CHARACTER(len=20), POINTER :: t_aheader
  DATA ioun7 /7/, ioun12 /12/, ioun13 /13/

END MODULE teq_mod

MODULE teqGS_output_mod
  USE sep_math
  REAL(rq), TARGET :: t_psires,t_rbin,t_rbout,t_pfcse,t_pftse,t_pfcsi,t_pfcil,&
       t_error,t_resb,t_resid
  REAL(rq), DIMENSION(:),   ALLOCATABLE, TARGET :: t_br0p,t_bz0p,t_pfjp,&
       t_pfjc,t_pfjf,t_pfbc,t_pfbi,t_pfbo,t_pfbr,t_pfbz,t_pfhs,t_pfms,&
       t_pffr,t_pffz,t_pfil,t_pfse,t_pfe0,t_pfpsi, t_vlts2D,t_gloop,t_ccls,&
       t_rcs,t_zcs,t_ths
  REAL(rq), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_pfim,t_floop,t_ploop
  INTEGER, POINTER :: t_nbs
  INTEGER, TARGET :: t_kbfc=-2,t_ncircuit=-2,t_ngroup=-2,t_ncrmx=-2,&
       t_nczmx=-2,t_ifjx=-2,t_ifbx=-2,t_ncs=-2,t_jbdcir=-2
  INTEGER, DIMENSION(:), ALLOCATABLE, TARGET :: t_icc,t_loopm,t_loop0

END MODULE teqGS_output_mod

MODULE teqGS_input_mod
  USE sep_math
  REAL(rq), DIMENSION(:), POINTER :: t_rbd,t_tbd,t_zbd,t_rfbd,t_zfbd,t_psiwfc,&
       t_whtz,t_alfbd,t_rloop,t_zloop,t_sigloop,t_floop0,t_thloop,t_cc,t_rc,&
       t_zc,t_drc,t_dzc,t_ac,t_ac2,t_lextc,t_svec,t_rcase,t_zcase,t_drcase,&
       t_dzcase,t_rhc,t_rextc,t_pfps0,t_cc0,t_rxc,t_rlim,t_zlim,t_dlim
  INTEGER,  DIMENSION(:), POINTER :: t_nrc,t_nzc,t_iferro,t_ic,t_ix,t_iloop,&
       t_ict
  LOGICAL, POINTER :: t_crj_flag
  REAL(rq), DIMENSION(:,:), POINTER :: t_gdc
  REAL(rq), POINTER :: t_dt,t_thetat,t_ccoil,t_zocoil,t_rocoil,t_rbcoil,&
       t_elcoil,t_dcoil,t_qcoil,t_cnorm,t_crdn,t_acmin,t_magfac,t_bsat,&
       t_dsurf,t_almim,t_geomo,t_pfjx,t_pfbx,t_delc,t_pftd,t_pfahs,t_dfac,&
       t_dtofst,t_bbdu,t_bbdl,t_dbdu,t_dbdl,t_ebdu,t_ebdl,t_queu,t_quel,&
       t_alpcoilc,t_alpsphc,t_epsb,t_epsj,t_alpcoil,t_alpsph,t_vltf,t_rfix,&
       t_psires0,t_raxis0,t_zaxis0,t_cejima,t_plcx,t_rl,t_rb,t_betx,t_finit2,&
       t_el,t_elx,t_psil00,t_rxpt0,t_zxpt0
  INTEGER, POINTER :: t_nbd,t_nfbd,t_nbdl,t_nbdu,t_lgrn,t_kgreenc,t_ncplot,&
       t_nc,t_nloop,t_limw,t_nsymc,t_lcal,t_nitr,t_ierr1,t_nlim,t_lsph,t_nsph,&
       t_iflxc,t_ixpt,t_ncsym,t_irl,t_jaxis,t_kaxis,t_keqic,t_ifscl,t_ipscl,&
       t_ibdry,t_ni,t_nl,t_ixp,t_ixpo,t_initflx,t_ksave,t_lop0,t_int_flag,&
       t_gauss_even,t_gauss_odd,t_gauss_chck,t_lasteq,t_nfil,t_ngp,t_nfjx,&
       t_ncase,t_ncoil,t_liml,t_lasteqsav,t_nfbc,t_nmsc,t_jxp,t_kxp
  CHARACTER(len=8), DIMENSION(:), POINTER :: t_pfid
END MODULE teqGS_input_mod

MODULE teqGS_mod
  USE sep_utils
  USE teqGS_input_mod
  USE teqGS_output_mod
  IMPLICIT NONE
  REAL(rq), DIMENSION(:), ALLOCATABLE, TARGET :: t_rcf,t_zcf,t_ccf,t_drcf,&
       t_dzcf,t_rcmf,t_zcmf,t_aac,t_cmplas,t_cscl,t_cscl00,t_cscl01,t_cclsr,&
       t_pfpci,t_pfpc0,t_rcg,t_zcg,t_ccfd,t_ccmf,t_rgp,t_zgp,t_brgp,t_bzgp,&
       t_gplc
  INTEGER, DIMENSION(:), ALLOCATABLE, TARGET :: t_intc,t_jnt,t_knt,t_icn,&
       t_icf,t_icnf
  REAL(rq), DIMENSION(:,:),ALLOCATABLE, TARGET :: t_gcw,t_splw,t_rc4,t_zc4,&
       t_pbim,t_gsbr,t_gsbz
  REAL(rq), DIMENSION(:,:,:),ALLOCATABLE, TARGET :: t_gc,t_gfbr,t_gfbz,t_gpl,&
       t_gp,t_plim,t_gplw
  REAL(rq), DIMENSION(:),POINTER ::t_zbd00,t_rbd00,t_zbd01,t_rbd01,t_zfbd00,&
       t_rfbd00,t_zfbd01,t_rfbd01,t_psibd
  REAL(rq), TARGET :: t_prsx00,t_prsx01,t_rlimm,t_zlimm,t_scl
  INTEGER, POINTER :: t_ncf,t_jm0p,t_km0p,t_nc0b,t_nc0p,t_nloop0p
  INTEGER, POINTER :: t_ncfo,t_nsymco,t_ngpo
END MODULE teqGS_mod

MODULE teqPol_mod
  USE sep_math
  REAL(rq), DIMENSION(:), ALLOCATABLE, TARGET :: t_qrk,t_jrk,t_srk,t_frk,&
       t_trk,t_rrk,t_zrk,t_vrk,t_crk,t_p,t_pp,t_f,t_pff
  REAL(rq), DIMENSION(:,:), POINTER :: t_rork,t_aj
  REAL(rq), POINTER :: t_tpl,t_epsrk,t_epskrk,t_anun,t_alfa0,t_alfa1,t_alfa2,&
       t_qmax,t_inv_x
  INTEGER, POINTER :: t_nht,t_ns1,t_ijob,t_mesc,t_inv_k,t_inv_p,t_inv_flag
  LOGICAL, POINTER :: t_itimestep_converged,t_iter_bdry
  INTEGER, POINTER :: t_npo,t_ntet
END MODULE teqPol_mod
  
MODULE teqSurf_mod
  USE sep_math
  REAL(rq), DIMENSION(:,:), ALLOCATABLE,TARGET ::t_plsolo,t_plsoli,t_tlsolo,&
       t_tlsoli
  REAL(rq), DIMENSION(:),   ALLOCATABLE,TARGET :: t_rpts,t_zpts
  INTEGER, POINTER :: t_nsol,t_nsep,t_npri,t_lflux,t_jqm,t_jqd
END MODULE teqSurf_mod


MODULE teqSubs_mod
  USE sep_math
  IMPLICIT NONE

CONTAINS

  SUBROUTINE svd_Invert(asvd)
    USE sep_utils
    IMPLICIT NONE
    REAL(rq), DIMENSION(:, :), INTENT(INOUT) :: asvd
    REAL(rq) :: usvd(SIZE(asvd,1),SIZE(asvd,1)),ssvd(SIZE(asvd,1))
    REAL(rq) :: vsvd(SIZE(asvd,2),SIZE(asvd,2))
    REAL(rq) :: wsvd(SIZE(asvd,1)*SIZE(asvd,2))
    INTEGER :: msvd,nsvd

    CHARACTER*1 vt,u
    INTEGER info,l,i,j,k
    REAL(rq) err

    msvd=SIZE(asvd,1)
    nsvd=SIZE(asvd,2)
    usvd=0;vsvd=0
    vt="A"
    u ="A"
    err=errt_rq**0.75_rq ! d1mach(3)**.75_rq
    l=msvd*nsvd
    CALL gesvd(u,vt,msvd,nsvd,asvd,msvd,ssvd,usvd,msvd,vsvd,nsvd,wsvd,l,info)
    IF (msvd<=nsvd) THEN
       DO i=1,msvd
          IF (ssvd(i)>err*ssvd(1)) THEN
             ssvd(i)=1._rq/ssvd(i)
          ELSE
             ssvd(i)=0
          END IF
       END DO
       DO i=1,nsvd
          DO j=1,msvd
             asvd(j,i)=SUM(vsvd(:msvd,i)*ssvd(:msvd)*usvd(j,:msvd))
          END DO
       END DO
    ELSE
       DO i=1,nsvd
          IF (ssvd(i).gt.err*ssvd(1)) THEN
             ssvd(i)=1._rq/ssvd(i)
          ELSE
             ssvd(i)=0
          END IF
       END DO
       DO i=1,msvd
          DO j=1,nsvd
             asvd(i,j)=SUM(vsvd(:nsvd,i)*ssvd(:nsvd)*usvd(j,:nsvd))
          END DO
       END DO
    END IF

  END SUBROUTINE svd_Invert

  SUBROUTINE teqPol_allocate
    USE teqPol_mod
    INTEGER :: npoo,nteto
    DATA npoo/0/,nteto/0/
    IF(t_npo/=npoo) THEN
       IF(npoo/=0) DEALLOCATE(t_qrk,t_jrk,t_srk,t_frk,t_trk,t_rrk,t_zrk,t_vrk,&
            t_crk,t_f,t_pff,t_p,t_pp)
       ALLOCATE(t_qrk(t_npo),t_jrk(t_npo),t_srk(t_npo),t_frk(t_npo),&
            t_trk(t_npo),t_rrk(t_npo),t_zrk(t_npo),t_vrk(t_npo),t_crk(t_npo),&
            t_f(t_npo),t_pff(t_npo),t_p(t_npo),t_pp(t_npo))
       t_qrk=0
       t_jrk=0
       t_srk=0
       t_frk=0
       t_trk=0
       t_rrk=0
       t_zrk=0
       t_vrk=0
       t_crk=0
       t_f=0
       t_pff=0
       t_p=0
       t_pp=0
    END IF
    IF(t_npo/=npoo .OR. t_ntet/=nteto) THEN
       IF(npoo/=0 .AND. nteto/=0) DEALLOCATE(t_aj)
       ALLOCATE(t_aj(t_npo,t_ntet))
       t_aj=0
    END IF
    npoo=t_npo;nteto=t_ntet
  END SUBROUTINE teqPol_allocate

  SUBROUTINE teq_allocate
  USE teqPol_mod
  USE teq_mod
    INTEGER, SAVE :: msrfo,jmo,kmo,mlso,jmkmo,mlfo,lmaxo,npolyo
    INTEGER :: mlf,ls
    DATA msrfo /0/,jmo /0/,kmo /0/,jmkmo /0/,mlso/0/,mlfo/0/,lmaxo/0/

    mlf=t_mls*t_msrf
    IF(t_msrf/=msrfo .OR. t_npoly/=npolyo) THEN
       IF(msrfo/=0 .AND. npolyo/=0) DEALLOCATE(t_mpoly,t_dpoly,t_spoly,&
            t_mpoli,t_dpoli,t_spoli)
       ALLOCATE(t_mpoly(t_npoly,t_npoly),t_dpoly(t_msrf,t_npoly),&
            t_spoly(t_msrf,t_npoly),t_mpoli(t_npoly,t_npoly),&
            t_dpoli(t_msrf-1,t_npoly),t_spoli(t_msrf-1,t_npoly))
       t_mpoly=0
       t_dpoly=0
       t_spoly=0
       t_mpoli=0
       t_dpoli=0
       t_spoli=0
       npolyo=t_npoly
    END IF
    IF(t_msrf/=msrfo) THEN
       IF(msrfo/=0) DEALLOCATE(&
            t_frsrf,t_fpsrf,t_qsrf,t_rsqbp,t_jtsrf,t_jparsrf,t_susrf,t_cusrf,&
            t_vpsrf,t_srsrf,t_prsrf,t_pdsrf,t_rsrf,t_asrf,t_volsrf,t_c1srf,&
            t_c4srf,t_c5srf,t_esrf,t_tsrf,t_r2bzrf,t_r4bp2rf,t_rsqrf,t_bpsrf,&
            t_bsqrf,t_rsqirf,t_alsrf,t_risrf,t_qh,t_psibar,t_phibar,t_psrf,&
            t_vptor,t_psiinv,t_psidinv,t_rhosrf,t_psidbar,t_thhsrf,t_lhsrf,&
            t_tlsrf,t_tusrf,t_fttcsrf)
       ALLOCATE(&
            t_frsrf(t_msrf),t_fpsrf(t_msrf),t_qsrf(t_msrf),t_rsqbp(t_msrf),&
            t_jtsrf(t_msrf),t_jparsrf(t_msrf),t_susrf(t_msrf),t_cusrf(t_msrf),&
            t_vpsrf(t_msrf),t_srsrf(t_msrf),t_prsrf(t_msrf),t_pdsrf(t_msrf),&
            t_rsrf(t_msrf),t_asrf(t_msrf),t_volsrf(t_msrf),t_qh(t_msrf),&
            t_c1srf(t_msrf),t_c4srf(t_msrf),t_c5srf(t_msrf),t_esrf(t_msrf),&
            t_tsrf(t_msrf),t_r2bzrf(t_msrf),t_r4bp2rf(t_msrf),t_rsqrf(t_msrf),&
            t_bpsrf(t_msrf),t_bsqrf(t_msrf),t_rsqirf(t_msrf),t_alsrf(t_msrf),&
            t_risrf(t_msrf),t_psibar(t_msrf),t_phibar(t_msrf),t_psrf(t_msrf),& 
            t_vptor(t_msrf),t_psiinv(t_msrf),t_psidinv(t_msrf),t_rhosrf(t_msrf),&
            t_psidbar(t_msrf),t_thhsrf(t_msrf,2),t_lhsrf(t_msrf,2),&
            t_tlsrf(t_msrf),t_tusrf(t_msrf),t_fttcsrf(t_msrf))
       t_frsrf=0
       t_fpsrf=0
       t_qsrf=0
       t_rsqbp=0
       t_jtsrf=0
       t_jparsrf=0
       t_susrf=0
       t_cusrf=0
       t_vpsrf=0
       t_srsrf=0
       t_prsrf=0
       t_pdsrf=0
       t_rsrf=0
       t_asrf=0
       t_volsrf=0
       t_c1srf=0
       t_c4srf=0
       t_c5srf=0
       t_esrf=0
       t_tsrf=0
       t_r2bzrf=0
       t_r4bp2rf=0
       t_rsqrf=0
       t_bpsrf=0
       t_bsqrf=0
       t_rsqirf=0
       t_alsrf=0
       t_risrf=0
       t_qh=0
       t_psibar=0
       t_phibar=0
       t_psrf=0
       t_vptor=0
       t_psiinv=0
       t_psidinv=0
       t_rhosrf=0
       t_psidbar=0
       t_thhsrf=0
       t_lhsrf=0
       t_tlsrf=0
       t_tusrf=0
       t_fttcsrf=0
    END IF
       msrfo=t_msrf

    IF(mlf/=mlfo) THEN
       IF(mlfo/=0) DEALLOCATE(t_rlsd,t_zlsd)
       ALLOCATE(t_rlsd(t_mls,t_msrf,5),t_zlsd(t_mls,t_msrf,5))
       t_rlsd=0;t_zlsd=0
       mlfo=mlf
    END IF

    IF(t_mls/=mlso) THEN
       IF(mlso/=0) DEALLOCATE(t_tswpts,t_brwpts,t_bzwpts)
       ALLOCATE(t_tswpts(t_mls),t_brwpts(t_mls),t_bzwpts(t_mls))
       mlso=t_mls
       t_tswpts=(/(ls,ls=0,t_mls-1)/)*TWOPI/(t_mls-1)
       t_brwpts=cos(t_tswpts)
       t_bzwpts=sin(t_tswpts)
    END IF

    IF(t_jm/=jmo) THEN
       IF(jmo/=0) DEALLOCATE(t_fldind)
       ALLOCATE(t_fldind(t_jm))
       t_fldind=0
       jmo=t_jm
    END IF

    IF(t_jm*t_km/=jmkmo) THEN
       IF(jmkmo/=0) DEALLOCATE(&
            t_br,t_bz,t_bp,t_bt,t_bmod,t_crj,t_pvec,t_rm,t_zm,t_psiw,t_clj,&
            t_psi00,t_psi01)
       jmkmo=t_jm*t_km
       t_jmkm=jmkmo
       ALLOCATE(&
            t_crj(jmkmo),t_rm(jmkmo),t_zm(jmkmo),t_br(jmkmo),t_bz(jmkmo),&
            t_bp(jmkmo),t_bt(jmkmo),t_bmod(jmkmo),t_psiw(jmkmo),t_clj(jmkmo)&
            ,t_psi00(jmkmo),t_psi01(jmkmo),t_pvec(jmkmo))
       t_br=0
       t_bz=0
       t_bp=0
       t_bt=0
       t_bmod=0
       t_crj=0
       t_pvec=0
       t_rm=0
       t_zm=0
       t_psiw=0
       t_clj=0
       t_psi00=0
       t_psi01=0
    END IF
    IF(t_lmax/=lmaxo) THEN
       IF(lmaxo/=0) DEALLOCATE(t_pdls,t_rlimw,t_zlimw,t_tlimw,t_plimw)
       lmaxo=t_lmax
       ALLOCATE(t_pdls(t_lmax,8),t_rlimw(t_lmax),t_zlimw(t_lmax),&
            t_tlimw(t_lmax),t_plimw(t_lmax))
       t_pdls=0
       t_rlimw=0
       t_zlimw=0
       t_tlimw=0
       t_plimw=0
       lmaxo=t_lmax
    END IF
  END SUBROUTINE teq_allocate

  SUBROUTINE teqSurf_allocate
    USE teqSurf_mod
    USE teq_input_mod, ONLY : t_nsym,t_mls

    integer :: sz1, sz2

    sz1 = 0; sz2 = 0
    if (allocated(t_plsolo)) then
       sz1 = size(t_plsolo,1)
       sz2 = size(t_plsolo,2)
    end if
    IF ((sz1/=t_nsym .OR. sz2/=t_nsol) .AND. t_nsol/=0) THEN
       IF(ALLOCATED(t_plsolo)) DEALLOCATE(t_plsolo,t_plsoli,t_tlsolo,t_tlsoli)
       ALLOCATE(t_plsolo(t_nsym,t_nsol),t_plsoli(t_nsym,t_nsol),&
            t_tlsolo(t_nsym,t_nsol),t_tlsoli(t_nsym,t_nsol))
       t_plsolo=0
       t_plsoli=0
       t_tlsolo=0
       t_tlsoli=0
    END IF
    sz1 = 0; if (allocated(t_rpts)) sz1 = size(t_rpts)
    IF (sz1/=t_mls) THEN
       IF(ALLOCATED(t_rpts)) DEALLOCATE(t_rpts,t_zpts)
       ALLOCATE(t_rpts(t_mls),t_zpts(t_mls))
       t_rpts=0
       t_zpts=0
    END IF
  END SUBROUTINE teqSurf_allocate

  SUBROUTINE teqGS_allocate_output
    USE teqGS_mod
    IMPLICIT NONE
    INTEGER, SAVE :: nco,ngroupo
    DATA nco/0/,ngroupo/-1/

    IF(t_nc/=nco) THEN
       IF(nco/=0) DEALLOCATE(t_cmplas,t_cscl,t_ccls,t_cscl00,t_cscl01,t_cclsr,&
            t_pfjp,t_pfjc,t_pfjf,t_pfbc,t_pfbi,t_pfbo,t_pfbr,t_pfbz,t_pfhs,&
            t_pfms,t_pffr,t_pffz,t_pfil,t_pfse,t_pfe0,t_pfpsi,t_vlts2D,t_rc4,&
            t_zc4,t_icc,t_loopm,t_loop0)
       ALLOCATE(t_cmplas(t_nc),t_cscl(t_nc),t_ccls(0:t_nc),t_cscl00(t_nc),&
            t_cscl01(t_nc),t_cclsr(t_nc),t_pfjp(t_nc),t_pfjc(t_nc),t_pfjf(t_nc),&
            t_pfbc(t_nc),t_pfbi(t_nc),t_pfbo(t_nc),t_pfbr(t_nc),t_pfbz(t_nc),&
            t_pfhs(t_nc),t_pfms(t_nc),t_pffr(t_nc),t_pffz(t_nc),t_pfil(t_nc),&
            t_pfse(t_nc),t_pfe0(t_nc),t_pfpsi(t_nc),t_vlts2D(t_nc), t_rc4(4,t_nc),&
            t_zc4(4,t_nc),t_icc(t_nc),t_loopm(t_nc),t_loop0(t_nc))

       t_cmplas=0
       t_cscl=0
       t_ccls=0
       t_cscl00=0
       t_cscl01=0
       t_cclsr=0
       t_pfjp=0
       t_pfjc=0
       t_pfjf=0
       t_pfbc=0
       t_pfbi=0
       t_pfbo=0
       t_pfbr=0
       t_pfbz=0
       t_pfhs=0
       t_pfms=0
       t_pffr=0
       t_pffz=0
       t_pfil=0
       t_pfse=0
       t_pfe0=0
       t_pfpsi=0
       t_vlts2D=0
       t_rc4=0
       t_zc4=0
       t_icc=0
       t_loopm=0
       t_loop0=0
       nco=t_nc
    END IF
    IF(ngroupo/=t_ngroup) THEN
       IF(ngroupo/=-1) DEALLOCATE(t_pfpci,t_pfpc0,t_rcg,t_zcg)
       ALLOCATE(t_pfpci(0:t_ngroup),t_pfpc0(0:t_ngroup),t_rcg(0:t_ngroup),&
            t_zcg(0:t_ngroup))
       t_pfpci=0
       t_pfpc0=0
       t_rcg=0
       t_zcg=0
       ngroupo=t_ngroup
    END IF
  END SUBROUTINE teqGS_allocate_output

  SUBROUTINE teq_allocate_greens
    USE teqGS_mod
    IMPLICIT NONE
    INTEGER :: n1,n2,n3

    n1 = 0; n2 = 0
    if (allocated(t_plim)) then
       n1 = size(t_plim,1); n2 = size(t_plim,2)
    end if
    n3=t_nc0p*t_nloop0p
    IF(n3/=0 .AND. (n1/=t_nc0p .OR. n2/=t_nloop0p)) THEN
       IF(n1>1 .AND. n2>1) DEALLOCATE(t_plim)
       IF(t_nc0p/=0 .AND. t_nloop0p/=0)ALLOCATE(t_plim(t_nc0p,t_nloop0p,3))
       t_plim=0
    END IF

    n1 = 0; if (allocated(t_pfim)) n1 = size(t_pfim,1)
    n3=t_nc
    IF(n3/=0 .AND. n1/=t_nc) THEN
       IF(n1>1) DEALLOCATE(t_pfim)
       ALLOCATE(t_pfim(t_nc,t_nc))
       t_pfim=0
    END IF

    n1 = 0; if (allocated(t_pbim)) n1 = size(t_pbim,1)
    n3=t_ncsym
    IF(n3/=0 .AND. n1/=t_ncsym) THEN
       IF(ALLOCATED(t_pbim)) DEALLOCATE(t_pbim)
       IF(t_ncsym/=0) ALLOCATE(t_pbim(t_ncsym,t_ncsym))
       t_pbim=0
    END IF

    n1 = 0; if (allocated(t_rcf)) n1 = size(t_rcf)
    n3=t_ncf
    IF(n3/=0 .AND. n1/=t_ncf) THEN
       IF(n1>1) DEALLOCATE(t_rcf,t_zcf,t_ccf,t_drcf,t_dzcf,t_rcmf,t_zcmf,&
            t_intc,t_jnt,t_knt,t_ccfd,t_ccmf,t_aac,t_rcs,t_zcs,t_ths,t_icf,&
            t_icnf,t_icn)
       ALLOCATE(t_rcf(t_ncf),t_zcf(t_ncf),t_drcf(t_ncf),t_dzcf(t_ncf),&
            t_ccf(t_ncf),t_rcmf(t_ncf),t_zcmf(t_ncf),t_intc(t_ncf),&
            t_jnt(t_ncf),t_knt(t_ncf),t_ccfd(t_ncf),t_ccmf(t_ncf),&
            t_aac(t_ncf),t_rcs(t_ncf),t_zcs(t_ncf),t_ths(t_ncf),t_icf(t_ncf),&
            t_icnf(t_ncf),t_icn(t_ncf))
       t_rcf=0
       t_zcf=0
       t_ccf=0
       t_drcf=0
       t_dzcf=0
       t_rcmf=0
       t_zcmf=0
       t_intc=0
       t_jnt=0
       t_knt=0
       t_ccfd=0
       t_ccmf=0
       t_aac=0
       t_rcs=0
       t_zcs=0
       t_ths=0
       t_icf=0
       t_icnf=0
       t_icn=0

    END IF

    n1 = 0; if (allocated(t_gloop)) n1 = size(t_gloop)
    n3=t_nloop
    IF(n3/=0 .AND. n1/=t_nloop) THEN
       IF(n1>1) DEALLOCATE(t_floop,t_ploop,t_gloop)
       ALLOCATE(t_floop(t_nloop,3),t_ploop(t_nloop,3),t_gloop(t_nloop))
       t_floop=0
       t_ploop=0
       t_gloop=0
    END IF

    n1 = 0; n2 = 0
    if (allocated(t_gc)) then
       n1=SIZE(t_gc,1)*SIZE(t_gc,2);n2=SIZE(t_gc,3)
    end if
    n3=t_jm0p*t_km0p*t_nc0p
    IF(n3/=0 .AND. (n1/=t_jm0p*t_km0p .OR. n2/=t_nc0p)) THEN
       IF(n1>1 .AND. n2>1) DEALLOCATE(t_gc,t_gfbr,t_gfbz)
       ALLOCATE(t_gc(t_jm0p,t_km0p,t_nc0p),t_gfbr(t_jm0p,t_km0p,t_nc0p),&
            t_gfbz(t_jm0p,t_km0p,t_nc0p))
       t_gc=0
       t_gfbr=0
       t_gfbz=0
    END IF
    n2 = 0; if (allocated(t_br0p)) n2 = size(t_br0p)
    n3=t_nc0p
    IF(n3/=0 .AND. n2/=t_nc0p) THEN
       IF(n2>1) DEALLOCATE(t_br0p,t_bz0p)
       ALLOCATE(t_br0p(t_nc0p),t_bz0p(t_nc0p))
       t_br0p=0
       t_bz0p=0
    END IF
    n2 = 0; if (allocated(t_gp)) n2 = size(t_gp,3)
    n3=t_jm0p*t_km0p*t_nc0b
    IF(n3/=0 .AND. (n1/=t_jm0p*t_km0p .OR. n2/=t_nc0b)) THEN
       IF(n1>1 .AND. n2>1) DEALLOCATE(t_gp)
       ALLOCATE(t_gp(t_jm0p,t_km0p,t_nc0b))
       t_gp=0
    END IF
    n2 = 0; if (allocated(t_gpl)) n2 = size(t_gpl,2)
    n3=t_jm0p*t_km0p*t_nloop0p
    IF(n3/=0 .AND. (n1/=t_jm0p*t_km0p .OR. n2/=t_nloop0p)) THEN
       IF(n1>1 .AND. n2>1) DEALLOCATE(t_gpl)
       ALLOCATE(t_gpl(t_jm0p*t_km0p,t_nloop0p,3))
       t_gpl=0
    END IF
      
    n1 = 0; n2 = 0
    if (allocated(t_gcw)) then
       n1=SIZE(t_gcw,1);n2=SIZE(t_gcw,2)
    end if
    n3=t_nsph*t_nc0p
    IF(n3/=0 .AND. (n1/=t_nsph .OR. n2/=t_nc0p)) THEN
       IF(n1>1 .AND. n2>1) DEALLOCATE(t_gcw)
       ALLOCATE(t_gcw(t_nc0p,0:t_nsph))
       t_gcw=0
    END IF
    
    n1 = 0; n2 = 0
    if (allocated(t_gplw)) then
       n1=SIZE(t_gplw,1);n2=SIZE(t_splw,2)
    end if
    n3=t_nloop0p*t_nsph
    IF(n3/=0 .AND. (n1/=t_nloop0p .OR. n2/=t_nsph)) THEN
       IF(n1>1 .AND. n2>1) DEALLOCATE(t_gplw,t_splw)
       ALLOCATE(t_gplw(t_nloop0p,0:t_nsph,3),t_splw(t_nloop0p+1,t_nsph))
       t_gplw=0
       t_splw=0
    END IF
    n3=t_nsph
    IF(n3/=0 .AND. n2/=t_nsph) THEN
       IF(n2>1) DEALLOCATE(t_gplc)
       ALLOCATE(t_gplc(0:t_nsph))
       t_gplc=0
    END IF
    
    n1 = 0; if (allocated(t_rgp)) n1 = size(t_rgp)
    n3=t_nbs
    IF(n3/=0 .AND. n1/=t_nbs) THEN
       IF(ALLOCATED(t_rgp)) DEALLOCATE(t_rgp,t_zgp,t_brgp,t_bzgp)
       ALLOCATE(t_rgp(t_nbs),t_zgp(t_nbs),t_brgp(t_nbs),t_bzgp(t_nbs))
       t_rgp=0
       t_zgp=0
       t_brgp=0
       t_bzgp=0
    END IF
    n2 = 0; if (allocated(t_gsbr)) n2 = size(t_gsbr,1)
    n3=t_nc0p*t_nbs
    IF(n3/=0 .AND. (n1/=t_nbs .OR. n2/=t_nc0p)) THEN
       IF(ALLOCATED(t_gsbr)) DEALLOCATE(t_gsbr,t_gsbz)
       ALLOCATE(t_gsbr(t_nc0p,t_nbs),t_gsbz(t_nc0p,t_nbs))
       t_gsbr=0
       t_gsbz=0
    END IF

  END SUBROUTINE teq_allocate_greens
  
  SUBROUTINE t_stretch(jsrf,psill,psixx)
    USE teq_mod
    REAL(rq), INTENT(IN) ::  psill,psixx
    INTEGER, INTENT(IN) :: jsrf
    REAL(rq), SAVE :: hsrf_
    INTEGER, SAVE :: jsrf_=-999,msrf_=-999,inv_=-999
    INTEGER :: ls

    IF(jsrf/=jsrf_ .OR. t_msrf/=msrf_ .OR. t_inv_eq/=inv_ .OR. t_hsrf/=hsrf_) &
         THEN
       jsrf_=jsrf
       msrf_=t_msrf
       inv_=t_inv_eq
       hsrf_=t_hsrf
       CALL str_tch(jsrf,t_rhosrf,t_psidbar,t_psiinv,t_psidinv,t_hsrf)
    END IF
    t_psrf=psixx+(psill-psixx)*t_rhosrf
    t_psrf(t_msrf)=psill
    t_dpsi0=psill-psixx
    IF(t_ifluxcord==-1) THEN
       t_phibar=t_rhosrf
    ELSE
       t_psibar=t_rhosrf
    END IF
    t_tswpts=(/(ls,ls=0,t_mls-1)/)*TWOPI/(t_mls-1)
  END SUBROUTINE t_stretch

  SUBROUTINE str_tch(js,ds,dsd,di,did,aa)
    INTEGER, INTENT(IN) :: js
    REAL(rq), INTENT(IN) :: aa
    REAL(rq), DIMENSION(:), INTENT(OUT) :: ds,dsd,di,did
    REAL(rq) :: a,d,ee,b,bb
    INTEGER ms,ls,j,k
    ms=SIZE(ds)
    ds=(/(ls,ls=0,ms-1)/)/(ms-1.0_rq)
    di=((/(ls,ls=0,ms-1)/)-0.5_rq)/(ms-1.0_rq)
    did(:ms)=1
    dsd(:ms)=1
    di(1)=0
    did(1)=0.5_rq
    !     Range set by aa
    IF(aa<0) THEN
       ds=(ds-aa)/(1-2*aa)
       di=(di-aa)/(1-2*aa)
       dsd=1/(1-2*aa)
       did=1/(1-2*aa)
    ELSEIF(aa>0 .AND. aa<1) THEN
       a=(2*aa-1)/(1-aa)
       dsd=(1+a)/(1+a*ds)**2
       did=(1+a)/(1+a*di)**2
       ds =(1+a)*ds/(1+a*ds)
       di =(1+a)*di/(1+a*di)
    END IF
    IF(js>11) THEN
       j=js/10
       k=js-10*j
       a=j;b=k
       d=b**(a/(a+b))
    END IF
    IF(js== 0 .OR. js== 11 .OR. js == -11) THEN  !   doesn't stretch
       did=1
       dsd=1
    ELSEIF(js == -1 .OR. js== -22) THEN !  stretched at both ends with sin^2
       dsd=PI2*dsd*sin(Pi*ds)
       did=PI2*did*sin(Pi*di)
       ds=(sin(PI2*ds))**2
       di=(sin(PI2*di))**2
    ELSEIF(js == -21) THEN  ! stretches on axis (quadratic)
       dsd=PI2*dsd*sin(PI2*ds)
       did=PI2*did*sin(PI2*di)
       ds=1-cos(PI2*ds)
       di=1-cos(PI2*di)
    ELSEIF(js == -12) THEN  ! stretches on edge (quadratic)
       dsd=PI2*dsd*cos(PI2*ds)
       did=PI2*did*cos(PI2*di)
       ds=sin(PI2*ds)
       di=sin(PI2*di)
    ELSEIF(js == -23) THEN  ! stretches at both ends but now cubic at edge
       dsd=0.75_rq*PI2*dsd*(sin(3*PI2*ds)+sin(PI2*ds))
       did=0.75_rq*PI2*did*(sin(3*PI2*di)+sin(PI2*di))
       ds=1-0.25_rq*cos(3*PI2*ds)-0.75_rq*cos(PI2*ds)
       di=1-0.25_rq*cos(3*PI2*di)-0.75_rq*cos(PI2*di)
    ELSEIF(js == -32) THEN  ! stretches at both ends but now cubic at axis
       dsd=0.75_rq*PI2*dsd*(cos(PI2*ds)-cos(3*PI2*ds))
       did=0.75_rq*PI2*did*(cos(PI2*di)-cos(3*PI2*di))
       ds=0.75_rq*sin(PI2*ds)-0.25_rq*sin(3*PI2*ds)
       di=0.75_rq*sin(PI2*di)-0.25_rq*sin(3*PI2*di)
    ELSEIF(js == -33) THEN ! stretches at both ends cubically
       dsd=dsd*(1-cos(TWOPI*ds))
       did=did*(1-cos(TWOPI*di))
       ds=ds-sin(TWOPI*ds)/TWOPI
       di=di-sin(TWOPI*di)/TWOPI
    ELSE ! stretches with powers: x**j,(1-x)**k near the boundaries with
       !the same coefficients which accounts for the d dendence.
       ds=ds/(d+(1-d)*ds)
       di=di/(d+(1-d)*di)
       dsd=dsd*d/(d+(1-d)*ds)**2
       did=did*d/(d+(1-d)*di)**2
       IF(k/=1) THEN
          ds=1-ds
          di=1-di
          dsd=k*dsd*ds**(k-1)
          did=k*did*di**(k-1)
          ds=1-ds**k
          di=1-di**k
       END IF
       IF(j/=1) THEN
          dsd=j*dsd*ds**(j-1)
          did=j*did*di**(j-1)
          ds=ds**j
          di=di**j
       END IF
    END IF
    IF(aa<0) THEN
       ee=ds(1)
       bb=ds(ms)-ee
       ds=(ds-ee)/bb
       dsd=dsd/bb
       di=(di-ee)/bb
       did=did/bb
    END IF
    ds(1)=0
    ds(ms)=1
  END SUBROUTINE str_tch

END MODULE teqSubs_mod
