pkg/flt/flt_main.F

38663a2fb5 Jean*0001 #include "FLT_OPTIONS.h"
c806179eb4 Alis*0002
eacecc7041 Jean*0003 C     ==================================================================
                0004 C
                0005 C     Float Package for the MIT Model
                0006 C
                0007 C     Main Routines:
                0008 C
a11169c200 Jean*0009 C     o flt_main       - Integrates the floats forward and stores
                0010 C                        positions and vertical profiles at specific
                0011 C                        time intervals.
                0012 C     o flt_readparms  - Read parameter file
                0013 C     o flt_init_fixed - Initialise fixed
                0014 C     o flt_init_varia - Initialise the floats
                0015 C     o flt_restart    - Writes restart data to file (=> renamed: flt_write_pickup)
eacecc7041 Jean*0016 C
                0017 C     Second Level Subroutines:
                0018 C
a11169c200 Jean*0019 C     o flt_runga2     - Second order Runga-Kutta inetgration (default)
                0020 C     o flt_exchg      - Does a new distribution of floats over tiles
                0021 C                        after every integration step.
                0022 C     o flt_up         - moves float to the surface (if flag is set)
                0023 C                        and stores profiles to file
                0024 C     o flt_down       - moves float to its target depth (if flag is set)
                0025 C     o flt_traj       - stores positions and data to file
                0026 C     o flt_interp_linear  - contains blinear interpolation scheme
                0027 C     o flt_mapping        - contains mapping functions & subroutine
                0028 C     o flt_mdsreadvector  - modified mdsreadvector to read files
eacecc7041 Jean*0029 C
                0030 C     ToDo:
                0031 C
                0032 C     o avoid exchanges when arrays empty
                0033 C     o 3D advection of floats
                0034 C
                0035 C     ==================================================================
                0036 C
                0037 C     Documentation:
                0038 C
                0039 C     To be made....
                0040 C
                0041 C
                0042 C     started: Arne Biastoch abiastoch@ucsd.edu 10-Jan-2000
                0043 C              (adopted from version written by Detlef Stammer
                0044 C               for the old model code)
                0045 C
                0046 C     changed: Arne Biastoch abiastoch@ucsd.edu 21-JUN-2001
                0047 C
                0048 C     ==================================================================
c806179eb4 Alis*0049
2fc321ec23 Jean*0050 CBOP 0
                0051 C !ROUTINE: FLT_MAIN
c806179eb4 Alis*0052
2fc321ec23 Jean*0053 C !INTERFACE:
38663a2fb5 Jean*0054       SUBROUTINE FLT_MAIN (
eacecc7041 Jean*0055      I                      myTime, myIter, myThid )
c806179eb4 Alis*0056
2fc321ec23 Jean*0057 C     !DESCRIPTION:
38663a2fb5 Jean*0058 C     ==================================================================
                0059 C     SUBROUTINE FLT_MAIN
                0060 C     ==================================================================
                0061 C     o This routine steps floats forward in time and samples the model
                0062 C       state at float position every flt_int_traj time steps.
                0063 C       Also moves the float up and down and samples vertical profiles.
                0064 C
                0065 C     o Uses  2nd or fourth order runga-kutta
                0066 C     o Spatial interpolation is bilinear close to boundaries and otherwise
                0067 C       a polynomial interpolation.
                0068 C     o Particles are kept in grid space (with position of dp taken as
                0069 C       x(south), y(east) grid cell point)
                0070 C     o Calls profile every flt_int_prof time steps; in that event the
                0071 C       profile over the whole water column is written to file and the
                0072 C       float might be moved upwards to the surface (depending on its
                0073 C       configuration).
                0074 C     ==================================================================
c806179eb4 Alis*0075
a11169c200 Jean*0076 C     !USES:
                0077       IMPLICIT NONE
2fc321ec23 Jean*0078 C     == global variables ==
c806179eb4 Alis*0079 #include "SIZE.h"
2fc321ec23 Jean*0080 #include "EEPARAMS.h"
                0081 #include "PARAMS.h"
730d8469b1 Oliv*0082 #include "FLT_SIZE.h"
c806179eb4 Alis*0083 #include "FLT.h"
                0084
2fc321ec23 Jean*0085 C     !INPUT PARAMETERS:
                0086 C     myTime :: current time in simulation
                0087 C     myIter :: current iteration number
                0088 C     myThid :: my Thread Id number
38663a2fb5 Jean*0089       _RL myTime
eacecc7041 Jean*0090       INTEGER myIter, myThid
c806179eb4 Alis*0091
2fc321ec23 Jean*0092 C     !FUNCTIONS:
                0093       LOGICAL  DIFFERENT_MULTIPLE
                0094       EXTERNAL DIFFERENT_MULTIPLE
                0095
                0096 C     !LOCAL VARIABLES:
                0097 CEOP
38663a2fb5 Jean*0098
2fc321ec23 Jean*0099 #ifdef ALLOW_DEBUG
                0100       IF (debugMode) CALL DEBUG_ENTER( 'FLT_MAIN', myThid )
                0101 #endif
                0102
                0103 C--   integration of the float trajectories
                0104 #ifdef ALLOW_DEBUG
                0105          IF (debugMode) CALL DEBUG_CALL('FLT_RUNGA*', myThid )
                0106 #endif
3394409633 Oliv*0107 #ifdef FLT_SECOND_ORDER_RUNGE_KUTTA
eacecc7041 Jean*0108 c         WRITE(0,*) ' bf call flt_runga2', myIter
c806179eb4 Alis*0109          CALL TIMER_START('FLOATS RUNGA2      [FLT  LOOP]',myThid)
eacecc7041 Jean*0110          CALL FLT_RUNGA2( myTime, myIter, myThid )
c806179eb4 Alis*0111          CALL TIMER_STOP ('FLOATS RUNGA2      [FLT  LOOP]',myThid)
eacecc7041 Jean*0112 c         WRITE(0,*) ' af call flt_runga2', myIter
3394409633 Oliv*0113 #else
                0114 c         WRITE(0,*) ' bf call flt_runga4', myIter
                0115          CALL TIMER_START('FLOATS RUNGA4      [FLT  LOOP]',myThid)
                0116          CALL FLT_RUNGA4( myTime, myIter, myThid )
                0117          CALL TIMER_STOP ('FLOATS RUNGA4      [FLT  LOOP]',myThid)
                0118 c         WRITE(0,*) ' af call flt_runga4', myIter
                0119 #endif
38663a2fb5 Jean*0120
2fc321ec23 Jean*0121 C--   do exchanges between tiles if necessary
c806179eb4 Alis*0122
2fc321ec23 Jean*0123 #ifdef ALLOW_DEBUG
                0124          IF (debugMode) CALL DEBUG_CALL('FLT_EXCH*', myThid )
                0125 #endif
626d00bea6 Jean*0126          CALL TIMER_START('FLOATS EXCHG       [FLT  LOOP]',myThid)
ad773b031f Oliv*0127 #ifdef ALLOW_EXCH2
                0128          CALL FLT_EXCH2( myTime, myIter, myThid )
                0129 #else
626d00bea6 Jean*0130          CALL FLT_EXCHG( myTime, myIter, myThid )
ad773b031f Oliv*0131 #endif
626d00bea6 Jean*0132          CALL TIMER_STOP ('FLOATS EXCHG       [FLT  LOOP]',myThid)
c806179eb4 Alis*0133
2fc321ec23 Jean*0134 C--   store profiles every flt_int_prof time steps and move floats up and down
c806179eb4 Alis*0135
2fc321ec23 Jean*0136          IF (  DIFFERENT_MULTIPLE( flt_int_prof, myTime, deltaTClock )
                0137      &      ) THEN
                0138 #ifdef ALLOW_DEBUG
                0139            IF (debugMode) CALL DEBUG_CALL('FLT_UP', myThid )
                0140 #endif
626d00bea6 Jean*0141            CALL TIMER_START('FLOATS UP          [FLT  LOOP]',myThid)
                0142            CALL FLT_UP( myTime, myIter, myThid )
                0143            CALL TIMER_STOP ('FLOATS UP          [FLT  LOOP]',myThid)
eacecc7041 Jean*0144          ENDIF
c806179eb4 Alis*0145
2fc321ec23 Jean*0146 #ifdef ALLOW_DEBUG
                0147          IF (debugMode) CALL DEBUG_CALL('FLT_DOWN', myThid )
                0148 #endif
eacecc7041 Jean*0149 c         WRITE(0,*) ' bf call flt_down', myIter
626d00bea6 Jean*0150            CALL TIMER_START('FLOATS DOWN        [FLT  LOOP]',myThid)
                0151            CALL FLT_DOWN( myTime, myIter, myThid )
                0152            CALL TIMER_STOP ('FLOATS DOWN        [FLT  LOOP]',myThid)
eacecc7041 Jean*0153 c         WRITE(0,*) ' af call flt_down', myIter
c806179eb4 Alis*0154
2fc321ec23 Jean*0155 C--   store particles every flt_int_traj timesteps:
38663a2fb5 Jean*0156
2fc321ec23 Jean*0157          IF (  DIFFERENT_MULTIPLE( flt_int_traj, myTime, deltaTClock )
                0158      &      ) THEN
                0159 #ifdef ALLOW_DEBUG
                0160            IF (debugMode) CALL DEBUG_CALL('FLT_TRAJ', myThid )
                0161 #endif
eacecc7041 Jean*0162 c         WRITE(0,*) ' bf call flt_traj', myIter
626d00bea6 Jean*0163            CALL TIMER_START('FLOATS TRAJ        [FLT  LOOP]',myThid)
                0164            CALL FLT_TRAJ( myTime, myIter, myThid )
                0165            CALL TIMER_STOP ('FLOATS TRAJ        [FLT  LOOP]',myThid)
eacecc7041 Jean*0166 c         WRITE(0,*) ' af call flt_traj', myIter
                0167          ENDIF
c806179eb4 Alis*0168
2fc321ec23 Jean*0169 #ifdef ALLOW_DEBUG
                0170       IF (debugMode) CALL DEBUG_LEAVE( 'FLT_MAIN', myThid )
                0171 #endif
                0172
38663a2fb5 Jean*0173       RETURN
                0174       END