! ! $Header$ ! C $Id: oasis.true 589 2005-02-07 15:47:11Z abarral $ C**** C C**** *INICMA* - Initialize coupled mode communication for atmosphere C and exchange some initial information with Oasis C C Input: C ----- C KASTP : total number of timesteps in atmospheric model C KEXCH : frequency of exchange (in time steps) C KSTEP : length of timestep (in seconds) C C ----------------------------------------------------------- C SUBROUTINE inicma(kastp,kexch,kstep,imjm) c c INCLUDE "param.h" c INTEGER kastp, kexch, kstep,imjm,klon INTEGER iparal(3) INTEGER ifcpl, idt, info, imxtag, istep, jf c -- LOOP c #include "dimensions.h" INTEGER jjmp1 PARAMETER (jjmp1=jjm+1-1/jjm) #include "dimphy.h" c REAL zu10m(klon), zv10m(klon) REAL zwindsp(klon) c c -- LOOP c #include "param_cou.h" #include "inc_cpl.h" CHARACTER*3 cljobnam ! experiment name CHARACTER*6 clmodnam ! model name c EM: not used by Oasis2.4 CEM CHARACTER*6 clbid(2) ! for CLIM_Init call (not used) CEM ! must be dimensioned by the number of models CEM INTEGER nbid(2) ! for CLIM_Init call (not used) CEM ! must be dimensioned by the number of models CHARACTER*5 cloasis ! coupler name (Oasis) INTEGER imess(4) INTEGER getpid ! system functions INTEGER nuout CEM LOGICAL llmodel PARAMETER (nuout = 6) c #include "clim.h" #include "mpiclim.h" c #include "oasis.h" ! contains the name of communication technique. Here ! cchan=CLIM only is possible. c ! ctype=MPI2 c C ----------------------------------------------------------- C C* 1. Initializations C --------------- C WRITE(nuout,*) ' ' WRITE(nuout,*) ' ' WRITE(nuout,*) ' ROUTINE INICMA' WRITE(nuout,*) ' **************' WRITE(nuout,*) ' ' WRITE(nuout,*) ' ' c c Define the model name c clmodnam = 'lmdz.x' ! as in $NBMODEL in Cpl/Nam/namcouple.tmp c c Define the coupler name c cloasis = 'Oasis' ! always 'Oasis' as in the coupler c c c Define symbolic name for fields exchanged from atmos to coupler, c must be the same as (1) of the field definition in namcouple: c cl_writ(8)='COSHFICE' cl_writ(9)='COSHFOCE' cl_writ(10)='CONSFICE' cl_writ(11)='CONSFOCE' cl_writ(12)='CODFLXDT' c cl_writ(6)='COICTEMP' cl_writ(13)='COTFSICE' cl_writ(14)='COTFSOCE' cl_writ(15)='COTOLPSU' cl_writ(16)='COTOSPSU' cl_writ(17)='CORUNCOA' cl_writ(18)='CORIVFLU' cl_writ(19)='COCALVIN' c$$$ cl_writ(13)='COZOTAUX' c$$$ cl_writ(14)='COZOTAUV' c$$$ cl_writ(15)='COMETAUY' c$$$ cl_writ(16)='COMETAUU' cl_writ(1)='COTAUXXU' cl_writ(2)='COTAUYYU' cl_writ(3)='COTAUZZU' cl_writ(4)='COTAUXXV' cl_writ(5)='COTAUYYV' cl_writ(6)='COTAUZZV' c -- LOOP cl_writ(7)='COWINDSP' c -- LOOP c c Define files name for fields exchanged from atmos to coupler, c must be the same as (6) of the field definition in namcouple: c cl_f_writ(1)='flxatmos' cl_f_writ(2)='flxatmos' cl_f_writ(3)='flxatmos' cl_f_writ(4)='flxatmos' cl_f_writ(5)='flxatmos' cl_f_writ(6)='flxatmos' cl_f_writ(7)='flxatmos' cl_f_writ(8)='flxatmos' cl_f_writ(9)='flxatmos' cl_f_writ(10)='flxatmos' cl_f_writ(11)='flxatmos' cl_f_writ(12)='flxatmos' cl_f_writ(13)='flxatmos' cl_f_writ(14)='flxatmos' cl_f_writ(15)='flxatmos' cl_f_writ(16)='flxatmos' cl_f_writ(17)='flxatmos' cl_f_writ(18)='flxatmos' c -- LOOP cl_f_writ(19)='flxatmos' c -- LOOP c c c Define symbolic name for fields exchanged from coupler to atmosphere, c must be the same as (2) of the field definition in namcouple: c cl_read(1)='SISUTESW' cl_read(2)='SIICECOV' cl_read(3)='SIICEALW' cl_read(4)='SIICTEMW' c c Define files names for fields exchanged from coupler to atmosphere, c must be the same as (7) of the field definition in namcouple: c cl_f_read(1)='sstatmos' cl_f_read(2)='sstatmos' cl_f_read(3)='sstatmos' cl_f_read(4)='sstatmos' c c c Define the number of processors involved in the coupling for c Oasis (=1) and each model (as last two INTEGER on $CHATYPE line c in the namcouple); they will be stored in a COMMON in mpiclim.h c (used for CLIM/MPI2 only) mpi_nproc(0)=1 mpi_nproc(1)=1 mpi_nproc(2)=1 c c Define infos to be sent initially to oasis c imess(1) = kastp ! total number of timesteps in atmospheric model imess(2) = kexch ! period of exchange (in time steps) imess(3) = kstep ! length of atmospheric timestep (in seconds) imess(4) = getpid() ! PID of atmospheric model c c Initialization and exchange of initial info in the CLIM technique c IF (cchan.eq.'CLIM') THEN c c Define the experiment name : c cljobnam = 'CLI' ! as $JOBNAM in namcouple c c Start the coupling c (see lib/clim/src/CLIM_Init for the definition of input parameters) c cEM clbid(1)=' ' cEM clbid(2)=' ' cEM nbid(1)=0 cEM nbid(2)=0 CEM llmodel=.true. c c Define the number of processors used by each model as in c $CHATYPE line of namcouple (used for CLIM/MPI2 only) mpi_totproc(1)=1 mpi_totproc(2)=1 c c Define names of each model as in $NBMODEL line of namcouple c (used for CLIM/MPI2 only) cmpi_modnam(1)='lmdz.x' cmpi_modnam(2)='opa.xx' c Start the coupling c CALL CLIM_Init ( cljobnam, clmodnam, 3, 7, * kastp, kexch, kstep, * 5, 3600, 3600, info ) c IF (info.ne.CLIM_Ok) THEN WRITE ( nuout, *) ' inicma : pb init clim ' WRITE ( nuout, *) ' error code is = ', info CALL halte('STOP in inicma') ELSE WRITE(nuout,*) 'inicma : init clim ok ' ENDIF c c For each coupling field, association of a port to its symbolic name c c -Define the parallel decomposition associated to the port of each c field; here no decomposition for all ports. iparal ( clim_strategy ) = clim_serial iparal ( clim_length ) = imjm iparal ( clim_offset ) = 0 c c -Loop on total number of coupler-to-atmosphere fields c (see lib/clim/src/CLIM_Define for the definition of input parameters) DO jf=1, jpfldo2a CALL CLIM_Define (cl_read(jf), clim_in , clim_double, iparal $ , info ) WRITE(nuout,*) 'inicma : clim define done for ',jf $ ,cl_read(jf) END DO c c -Loop on total number of atmosphere-to-coupler fields c (see lib/clim/src/CLIM_Define for the definition of input parameters) DO jf=1, jpflda2o1+jpflda2o2 CALL CLIM_Define (cl_writ(jf), clim_out , clim_double, $ iparal, info ) WRITE(nuout,*) 'inicma : clim define done for ',jf $ ,cl_writ(jf) END DO c WRITE(nuout,*) 'inicma : clim_define ok ' c c -Join a pvm group, wait for other programs and broadcast usefull c informations to Oasis and to the ocean (see lib/clim/src/CLIM_Start) CALL CLIM_Start ( imxtag, info ) IF (info.ne.clim_ok) THEN WRITE ( nuout, *) 'inicma : pb start clim ' WRITE ( nuout, *) ' error code is = ', info CALL halte('stop in inicma') ELSE WRITE ( nuout, *) 'inicma : start clim ok ' ENDIF c c -Get initial information from Oasis c (see lib/clim/src/CLIM_Stepi) CALL CLIM_Stepi (cloasis, istep, ifcpl, idt, info) IF (info .NE. clim_ok) THEN WRITE ( UNIT = nuout, FMT = *) $ ' warning : problem in getting step info ', $ 'from oasis ' WRITE (UNIT = nuout, FMT = *) $ ' ======= error code number = ', info ELSE WRITE (UNIT = nuout, FMT = *) $ ' got step information from oasis ' ENDIF WRITE ( nuout, *) ' number of tstep in oasis ', istep WRITE ( nuout, *) ' exchange frequency in oasis ', ifcpl WRITE ( nuout, *) ' length of tstep in oasis ', idt ENDIF RETURN END c $Id: oasis.true 589 2005-02-07 15:47:11Z abarral $ SUBROUTINE fromcpl(kt, imjm, sst, gla, tice, albedo) c ====================================================================== c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine reads the SST c and Sea-Ice provided by the coupler with the CLIM (PVM exchange messages) c technique. c====================================================================== IMPLICIT none INTEGER imjm, kt REAL sst(imjm) ! sea-surface-temperature REAL gla(imjm) ! sea-ice REAL tice(imjm) ! temp glace REAL albedo(imjm) ! albedo glace c INTEGER nuout ! listing output unit PARAMETER (nuout=6) c INTEGER nuread, ios, iflag, icpliter INTEGER info, jf c #include "clim.h" c #include "oasis.h" #include "param_cou.h" c #include "inc_cpl.h" c c WRITE (nuout,*) ' ' WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt WRITE (nuout,*) ' ' CALL flush (nuout) IF (cchan.eq.'CLIM') THEN c c -Get interpolated oceanic fields from Oasis c DO jf=1,jpfldo2a IF (jf.eq.1) CALL CLIM_Import (cl_read(jf) , kt, sst, info) IF (jf.eq.2) CALL CLIM_Import (cl_read(jf) , kt, gla, info) IF (jf.eq.3) CALL CLIM_Import (cl_read(jf), kt,albedo, info) IF (jf.eq.4) CALL CLIM_Import (cl_read(jf) , kt, tice, info) IF ( info .NE. CLIM_Ok) THEN WRITE(nuout,*)'Pb in reading ', cl_read(jf), jf WRITE(nuout,*)'Couplage kt is = ',kt WRITE(nuout,*)'CLIM error code is = ', info CALL halte('STOP in fromcpl.F') ENDIF END DO ENDIF c RETURN END c $Id: oasis.true 589 2005-02-07 15:47:11Z abarral $ c -- LOOP SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat, $ fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, $ calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v, $ windsp, last) c -- LOOP c ====================================================================== c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the c atmospheric coupling fields to the coupler with the CLIM (PVM exchange c messages) technique. c IF last time step, writes output fields to binary files. c ====================================================================== IMPLICIT NONE c -- LOOP c #include "dimensions.h" INTEGER jjmp1 PARAMETER (jjmp1=jjm+1-1/jjm) #include "dimphy.h" c REAL zu10m(klon), zv10m(klon) REAL zwindsp(klon) c c -- LOOP c INTEGER kt, imjm c REAL fsolice(imjm) REAL fsolwat(imjm) REAL fnsolwat(imjm) REAL fnsolice(imjm) REAL fnsicedt(imjm) REAL evice(imjm) REAL evwat(imjm) REAL lpre(imjm) REAL spre(imjm) REAL dirunoff(imjm) REAL rivrunoff(imjm) REAL calving(imjm) c$$$ REAL tauxu(imjm) c$$$ REAL tauxv(imjm) c$$$ REAL tauyu(imjm) c$$$ REAL tauyv(imjm) REAL tauxx_u(imjm) REAL tauxx_v(imjm) REAL tauyy_u(imjm) REAL tauyy_v(imjm) REAL tauzz_u(imjm) REAL tauzz_v(imjm) c -- LOOP REAL windsp(imjm) c -- LOOP LOGICAL last c INTEGER nuout PARAMETER (nuout = 6) c #include "clim.h" #include "param_cou.h" #include "inc_cpl.h" c CHARACTER*8 file_name(jpmaxfld) INTEGER max_file INTEGER file_unit_max, file_unit(jpmaxfld), $ file_unit_field(jpmaxfld) INTEGER icstep, info, jn, jf, ierror LOGICAL trouve c #include "oasis.h" c icstep=kt c WRITE(nuout,*) ' ' WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt WRITE(nuout,*) 'last ', last WRITE(nuout,*) IF (last) THEN c c -WRITE fields to binary files for coupler restart at last time step c c -initialisation and files opening c max_file=1 file_unit_max=99 c -keeps first file name file_name(max_file)=cl_f_writ(max_file) c -keeps first file unit file_unit(max_file)=file_unit_max c -decrements file unit maximum file_unit_max=file_unit_max-1 c -keeps file unit for field file_unit_field(1)=file_unit(max_file) c c -different files names counter c DO jf= 2, jpflda2o1 + jpflda2o2 trouve=.false. DO jn= 1, max_file IF (.not.trouve) THEN IF (cl_f_writ(jf).EQ.file_name(jn)) THEN c -keep file unit for field file_unit_field(jf)=file_unit(jn) trouve=.true. END IF END IF END DO IF (.not.trouve) then c -increment the number of different files max_file=max_file+1 c -keep file name file_name(max_file)=cl_f_writ(jf) c -keep file unit for file file_unit(max_file)=file_unit_max c -keep file unit for field file_unit_field(jf)=file_unit(max_file) c -decrement unit maximum number from 99 to 98, ... file_unit_max=file_unit_max-1 END IF END DO c DO jn=1, max_file OPEN (file_unit(jn), FILE=file_name(jn), FORM='UNFORMATTED') WRITE(*,*) 'Opening FILE ', file_unit(jn), ' ' $ , file_name(jn) REWIND(file_unit(jn)) END DO c c WRITE fields to files DO jf=1, jpflda2o1 + jpflda2o2 IF (jf.eq.8) $ CALL locwrite(cl_writ(jf),fsolice, imjm, $ file_unit_field(jf), ierror) IF (jf.eq.9) $ CALL locwrite(cl_writ(jf),fsolwat, imjm, $ file_unit_field(jf), ierror) IF (jf.eq.10) $ CALL locwrite(cl_writ(jf),fnsolice, imjm, $ file_unit_field(jf), ierror) IF (jf.eq.11) $ CALL locwrite(cl_writ(jf),fnsolwat, imjm, $ file_unit_field(jf), ierror) IF (jf.eq.12) $ CALL locwrite(cl_writ(jf),fnsicedt, imjm, $ file_unit_field(jf), ierror) c IF (jf.eq.13) c $ CALL locwrite(cl_writ(jf),ictemp, imjm, c $ file_unit_field(jf), ierror) IF (jf.eq.13) $ CALL locwrite(cl_writ(jf),evice, imjm, $ file_unit_field(jf), ierror) IF (jf.eq.14) $ CALL locwrite(cl_writ(jf),evwat, imjm, $ file_unit_field(jf), ierror) IF (jf.eq.15) $ CALL locwrite(cl_writ(jf),lpre, imjm, $ file_unit_field(jf), ierror) IF (jf.eq.16) $ CALL locwrite(cl_writ(jf),spre, imjm, $ file_unit_field(jf), ierror) IF (jf.eq.17) $ CALL locwrite(cl_writ(jf),dirunoff, imjm, $ file_unit_field(jf), ierror) IF (jf.eq.18) $ CALL locwrite(cl_writ(jf),rivrunoff, imjm, $ file_unit_field(jf), ierror) IF (jf.eq.19) $ CALL locwrite(cl_writ(jf),calving, imjm, $ file_unit_field(jf), ierror) c$$$ IF (jf.eq.13) c$$$ $ CALL locwrite(cl_writ(jf),tauxu, imjm, c$$$ $ file_unit_field(jf),ierror) c$$$ IF (jf.eq.1') c$$$ $ CALL locwrite(cl_writ(jf),tauxv, imjm, c$$$ $ file_unit_field(jf),ierror) c$$$ IF (jf.eq.15) c$$$ $ CALL locwrite(cl_writ(jf),tauyv, imjm, c$$$ $ file_unit_field(jf),ierror) c$$$ IF (jf.eq.16) c$$$ $ CALL locwrite(cl_writ(jf),tauyu, imjm, c$$$ $ file_unit_field(jf), ierror) IF (jf.eq.1) $ CALL locwrite(cl_writ(jf),tauxx_u, imjm, $ file_unit_field(jf),ierror) IF (jf.eq.2) $ CALL locwrite(cl_writ(jf),tauyy_u, imjm, $ file_unit_field(jf),ierror) IF (jf.eq.3) $ CALL locwrite(cl_writ(jf),tauzz_u, imjm, $ file_unit_field(jf),ierror) IF (jf.eq.4) $ CALL locwrite(cl_writ(jf),tauxx_v, imjm, $ file_unit_field(jf),ierror) IF (jf.eq.5) $ CALL locwrite(cl_writ(jf),tauyy_v, imjm, $ file_unit_field(jf),ierror) IF (jf.eq.6) $ CALL locwrite(cl_writ(jf),tauzz_v, imjm, $ file_unit_field(jf),ierror) c -- LOOP IF (jf.eq.7) $ CALL locwrite(cl_writ(jf),windsp, imjm, $ file_unit_field(jf),ierror) c -- LOOP END DO C C -simulate a FLUSH C DO jn=1, max_file CLOSE (file_unit(jn)) END DO C C IF(cchan.eq.'CLIM') THEN C C -inform PVM daemon that message exchange is finished C CALL CLIM_Quit (CLIM_ContPvm, info) IF (info .NE. CLIM_Ok) THEN WRITE (6, *) $ 'An error occured while leaving CLIM. Error = ', $ info ENDIF END IF RETURN END IF C IF(cchan.eq.'CLIM') THEN C C -Give atmospheric fields to Oasis C DO jn=1, jpflda2o1 + jpflda2o2 C IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info) IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info) IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info) IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info) IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info) c IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info) IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, evice, info) IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, evwat, info) IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, lpre, info) IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, spre, info) IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info) IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info) IF (jn.eq.19) CALL CLIM_Export(cl_writ(jn),kt,calving,info) c$$$ IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info) c$$$ IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info) c$$$ IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info) c$$$ IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info) IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info) IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info) IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info) IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info) IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info) IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info) c -- LOOP IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, windsp, info) c -- LOOP IF (info .NE. CLIM_Ok) THEN WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn WRITE (nuout,*) ' at timestep = ', icstep,'kt = ',kt WRITE (nuout,*) 'Clim error code is = ',info CALL halte('STOP in intocpl ') ENDIF END DO ENDIF C RETURN END SUBROUTINE pipe_model_define print*,'Attention dans oasis.F, pipe_model_define est non defini' RETURN END SUBROUTINE pipe_model_stepi print*,'Attention dans oasis.F, pipe_model_stepi est non defini' RETURN END SUBROUTINE pipe_model_recv print *, 'Attention dans oasis.F, pipe_model_recv est non defini' RETURN END SUBROUTINE pipe_model_send print *, 'Attention dans oasis.F, pipe_model_send est non defini' RETURN END SUBROUTINE quitcpl print *, 'Attention dans oasis.F, quitcpl est non defini' RETURN END SUBROUTINE sipc_write_model print *, 'Attention dans oasis.F, sipc_write_model est non defini' RETURN END SUBROUTINE sipc_attach print *, 'Attention dans oasis.F, sipc_attach est non defini' RETURN END SUBROUTINE sipc_init_model print *, 'Attention dans oasis.F, sipc_init_model est non defini' RETURN END SUBROUTINE sipc_read_model print *, 'Attention dans oasis.F, sipc_read_model est non defini' RETURN END