doc-doxygen/html/prism__put__restart__proto_8_f90_source.html

00001   SUBROUTINE prism_put_restart_proto (id_port_id, kstep, kinfo)
00002 !
00003 !*    *** PRISM_put ***   PRISM 1.0
00004 !
00005 !     purpose:
00006 !     --------
00007 !        write buffered field corresponding to port id_port_id in its
00008 !        restart coupling file
00009 !
00010 !     interface:
00011 !     ----------
00012 !        id_port_id : port number of the field
00013 !    kstep  : current time in seconds
00014 !    kinfo  : output status
00015 !
00016 !     lib mp:
00017 !     -------
00018 !        none
00019 !
00020 !     author:
00021 !     -------
00022 !         Sophie Valcke (07/03 - created from prism_put_proto)
00023 !     ----------------------------------------------------------------
00024     USE mod_kinds_model
00025     USE mod_prism_proto
00026     USE mod_comprism_proto
00027     IMPLICIT NONE
00028 #if defined use_comm_MPI1 || defined use_comm_MPI2
00029 #include <mpif.h>
00030 #endif
00031 !     ----------------------------------------------------------------
00032     INTEGER (kind=ip_intwp_p)      kstep, kinfo, id_port_id
00033 !     ----------------------------------------------------------------
00034     INTEGER (kind=ip_intwp_p)      iport
00035 !     ----------------------------------------------------------------
00036 !
00037 !*    0. Entering
00038 !     -----------
00039 !
00040 #ifdef __VERBOSE
00041    WRITE(nulprt,*)'   '
00042    WRITE(nulprt,*)'| | | Entering routine prism_put_restart_proto'
00043    call flush(nulprt)
00044 #endif
00045 !
00046     kinfo = PRISM_Ok
00047 !
00048 !*    1. check for this port in my list
00049 !     ---------------------------------
00050 !
00051     iport = -1
00052 !
00053 !   Test if the field is defined in the namcouple and if its coupling period
00054 !   is not greater than the time of the simulation.
00055     IF (ig_def_freq(id_port_id) .eq. 0.or. &
00056          ig_def_freq(id_port_id) .gt. ig_ntime) THEN
00057        GOTO 1010
00058     ENDIF
00059 !
00060     IF (myport(1,id_port_id).eq.CLIM_Out) THEN
00061        iport=id_port_id
00062     ENDIF
00063     IF (iport.lt.0) THEN
00064        kinfo = CLIM_BadPort
00065        WRITE(nulprt,FMT='(A,A)') &
00066             'Put - WARNING - Invalid port out: ', &
00067             cports(id_port_id)
00068        GO TO 1010
00069     ENDIF
00070 !
00071 !*  Field is written to restart file
00072     IF (lg_dgfield) THEN
00073         IF (mydist(CLIM_Strategy,iport) .EQ. CLIM_Serial) THEN
00074             CALL write_filer8(dg_field_trans(:,iport),cports(iport),iport)
00075         ELSE
00076             CALL write_file_parar8(dg_field_trans(:,iport),cports(iport),iport)
00077         ENDIF
00078     ELSE
00079         IF (mydist(CLIM_Strategy,iport) .EQ. CLIM_Serial) THEN
00080             CALL write_filer8(rg_field_trans(:,iport),cports(iport),iport)
00081         ELSE
00082             CALL write_file_parar8(rg_field_trans(:,iport),cports(iport),iport)
00083         ENDIF
00084     ENDIF
00085     kinfo = PRISM_ToRest
00086 !
00087 !     ----------------------------------------------------------------
00088 !
00089 1010 CONTINUE
00090 !
00091 #ifdef __VERBOSE
00092     WRITE(nulprt,*)'| | | Leaving routine prism_put_restart_proto'
00093     WRITE(nulprt,*)'   '
00094 #endif
00095 !
00096     CALL FLUSH(nulprt)
00097 !
00098   END SUBROUTINE prism_put_restart_proto
00099