Subroutine run_cce
766 :
767 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
768 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
769 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
770 :
771 : subroutine run_cce ()
772 : use vom_sce_mod
773 : use vom_vegwat_mod
774 : !$ USE omp_lib
775 : implicit none
776 :
777 : INTEGER :: m_, first
778 : CHARACTER(300) :: writeformat
779 : CHARACTER(len=135) :: msg
780 :
781 : ! * PARTITION THE sopt POINTS INTO ncomp2 COMPLEXES
782 : ! * EXECUTE CCE ALGORITHM
783 :
784 : if (ncomp2 .gt. 1) then
785 : if (nloop .gt. 0) then
786 : if (ncomp2 .gt. i_ncompmin) then
787 : ncomp2 = ncomp2 - 1 ! REDUCE NUMBER OF COMPLEXES AS nloop INCREASES
788 : else
789 : if (worstbest .le. ofvec(1+(ncomp2-1)*mopt)) then
790 : writeformat = '("No gene pool mixing ... '
791 : writeformat(27:64) = 'reducing number of complexes by one.")'
792 : write(msg,writeformat)
793 : write(kfile_progress,*) TRIM(msg)
794 : ncomp2 = ncomp2 - 1
795 : endif
796 : endif
797 : endif
798 : endif
799 :
800 : bestincomp = -9999.d0 ! SET LESS THAN bestobj
801 : write(kfile_progress,*) "Looping over complexes"
802 :
803 : flush(kfile_progress)
804 : call OMP_SET_NUM_THREADS(n_thread)
805 : call vom_dealloc()
806 :
807 : !loop over complexes
808 : !!$OMP shared( ofvec)
809 : !$OMP parallel default(shared) &
810 : !$OMP private( m_, first, msg, writeformat) &
811 : !$OMP COPYIN( time, error, finish, nyear, nday, nhour, th_, c_testday, &
812 : !$OMP topt_, par_y, srad_y, vd_d, vd_y, &
813 : !$OMP rain_y, gammastar, wsnew, wsold, o_cai, pcg_d, c_pcgmin, &
814 : !$OMP o_wstexp, o_wsgexp, o_lambdatf, o_lambdagf, &
815 : !$OMP i_cz, i_cgs, i_zr, i_go, i_ksat, i_thetar, i_thetas, i_nvg, i_avg, &
816 : !$OMP lambdat_d, lambdag_d, gstomt, gstomg, &
817 : !$OMP rlt_h, rlt_d, rlt_y, rlg_h, rlg_d, rlg_y, transpt, transpg, q_tct_d, tct_y, tcg_d, &
818 : !$OMP tcg_y, jactt, jactg, jmaxt_h, jmaxg_h, jmax25t_d, jmax25g_d, &
819 : !$OMP asst_h, asst_d, asst_y, assg_h, assg_d, assg_y, &
820 : !$OMP q_cpcct_d, cpcct_y, cpccg_d, cpccg_y, etmt__, etmt_h, etmt_d, etmt_y, etmg__, etmg_h, &
821 : !$OMP etmg_d, etmg_y, etm_y, mqt_, mqtnew, mqtold, dmqt, q_mqx, mqsst_, mqsstmin, q_md, &
822 : !$OMP o_mdstore, o_rtdepth, o_rgdepth, pos_slt, pos_slg, pos_ult, pos_ulg, changef, &
823 : !$OMP rootlim, posmna, rrt_d, rrt_y, rrg_d, rrg_y, sumruptkt_h, &
824 : !$OMP wlayer_, wlayernew, dt_, dtmax, dtsu_count, dtmax_count, esoil__, esoil_h, &
825 : !$OMP esoil_d, esoil_y, spgfcf__, spgfcf_h, spgfcf_d, inf__, infx__, infx_h, infx_d, &
826 : !$OMP zw_, zwnew, wc_, io__, io_h, ioacum, &
827 : !$OMP ranscal, bestobj, bestincomp, evolution)
828 : !$OMP do SCHEDULE(DYNAMIC)
829 : do m_ = 1, ncomp2
830 :
831 : first = 1 + (m_ - 1) * mopt
832 : writeformat = '("Start of loop",i4,", complex",i2,'
833 : writeformat(36:55) = '": best OF =",e12.6)'
834 : write(msg,writeformat) nloop + 1, m_, ofvec(first)
835 : write(kfile_progress,*) TRIM(msg)
836 : flush(kfile_progress)
837 :
838 : if (m_ .eq. 1) then
839 : bestincomp = -9999.d0 ! SET LESS THAN bestobj
840 : else
841 : bestincomp = ofvec(first)
842 : endif
843 :
844 : !start CCE
845 : call cce(ofvec(first:m_*mopt), shufflevar(:,first:m_*mopt))
846 :
847 : !Deallocate some variables to avoid problems in parallel
848 : call vom_dealloc()
849 :
850 : writeformat(3:7) = ' End'
851 : write(msg,writeformat) nloop + 1, m_, ofvec(first)
852 : write(kfile_progress,*) TRIM(msg)
853 : flush(kfile_progress)
854 :
855 : enddo
856 : !$OMP end do
857 : !$OMP end parallel
858 :
859 : worstbest = ofvec(first)
860 :
861 : ! * WRITE shufflevar AND ofvec OF LAST LOOP TO FILE
862 : call writeloop()
863 : !close(kfile_sceout)
864 : close(kfile_bestpars)
865 : if (kfile_progress .ne. 6) close(kfile_progress)
866 :
867 : return
868 : end subroutine run_cce