florst.F90 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150
  1. MODULE florst
  2. !!======================================================================
  3. !! *** MODULE florst ***
  4. !!
  5. !!
  6. !! write floats restart files
  7. !!
  8. !!======================================================================
  9. !! History :
  10. !! 8.0 ! 99-09 (Y. Drillet) : Original code
  11. !! ! 00-06 (J.-M. Molines) : Profiling floats for CLS
  12. !! 8.5 ! 02-10 (A. Bozec) F90 : Free form and module
  13. !! 3.2 ! 10-08 (slaw, cbricaud): netcdf outputs and others
  14. !!----------------------------------------------------------------------
  15. #if defined key_floats || defined key_esopa
  16. !!----------------------------------------------------------------------
  17. !! 'key_floats' float trajectories
  18. !!----------------------------------------------------------------------
  19. !! * Modules used
  20. USE flo_oce ! ocean drifting floats
  21. USE dom_oce ! ocean space and time domain
  22. USE lib_mpp ! distribued memory computing library
  23. USE in_out_manager ! I/O manager
  24. IMPLICIT NONE
  25. PRIVATE
  26. PUBLIC flo_rst ! routine called by floats.F90
  27. PUBLIC flo_rst_alloc ! routine called by floats.F90
  28. INTEGER, ALLOCATABLE, DIMENSION(:) :: iperproc ! 1D workspace
  29. !! * Substitutions
  30. # include "domzgr_substitute.h90"
  31. !!----------------------------------------------------------------------
  32. !! NEMO/OPA 3.2 , LODYC-IPSL (2009)
  33. !! $Id: florst.F90 2355 2015-05-20 07:11:50Z ufla $
  34. !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
  35. !!----------------------------------------------------------------------
  36. CONTAINS
  37. INTEGER FUNCTION flo_rst_alloc()
  38. !!-------------------------------------------------------------------
  39. !! *** FUNCTION flo_rst_alloc ***
  40. !!-------------------------------------------------------------------
  41. ALLOCATE( iperproc(jpnij), STAT=flo_rst_alloc )
  42. !
  43. IF( lk_mpp ) CALL mpp_sum ( flo_rst_alloc )
  44. IF( flo_rst_alloc /= 0 ) CALL ctl_warn('flo_rst_alloc: failed to allocate arrays.')
  45. END FUNCTION flo_rst_alloc
  46. SUBROUTINE flo_rst( kt )
  47. !!---------------------------------------------------------------------
  48. !! *** ROUTINE flo_rst ***
  49. !!
  50. !! ** Purpose :
  51. !!
  52. !!
  53. !!
  54. !! ** Method : The frequency of ??? is nwritefl
  55. !!
  56. !!----------------------------------------------------------------------
  57. !! * Arguments
  58. INTEGER :: kt ! time step
  59. !! * Local declarations
  60. CHARACTER (len=80) :: clname ! restart filename
  61. INTEGER :: ic , jc , jpn ,jfl ! temporary integer
  62. INTEGER :: inum ! temporary logical unit for restart file
  63. !!----------------------------------------------------------------------
  64. IF( ( MOD(kt,nn_stockfl) == 0 ) .OR. ( kt == nitend ) )THEN
  65. IF(lwp) THEN
  66. WRITE(numout,*)
  67. WRITE(numout,*) 'flo_rst : write in restart_float file '
  68. WRITE(numout,*) '~~~~~~~ '
  69. ENDIF
  70. ! file is opened and closed every time it is used.
  71. clname = 'restart.float.'
  72. ic = 1
  73. DO jc = 1, 16
  74. IF( cexper(jc:jc) /= ' ' ) ic = jc
  75. END DO
  76. clname = clname(1:14)//cexper(1:ic)
  77. ic = 1
  78. DO jc = 1, 48
  79. IF( clname(jc:jc) /= ' ' ) ic = jc
  80. END DO
  81. inum=0
  82. IF( lwp )THEN
  83. CALL ctl_opn( inum, clname, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
  84. REWIND inum
  85. ENDIF
  86. !
  87. DO jpn = 1, jpnij
  88. iperproc(jpn) = 0
  89. END DO
  90. !
  91. IF(lwp) THEN
  92. REWIND(inum)
  93. WRITE (inum,*) tpifl,tpjfl,tpkfl,nisobfl,ngrpfl
  94. CLOSE (inum)
  95. ENDIF
  96. !
  97. ! Compute the number of trajectories for each processor
  98. !
  99. IF( lk_mpp ) THEN
  100. DO jfl = 1, jpnfl
  101. IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND. &
  102. &(INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND. &
  103. &(INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND. &
  104. &(INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN
  105. iperproc(narea) = iperproc(narea)+1
  106. ENDIF
  107. END DO
  108. CALL mpp_sum( iperproc, jpnij )
  109. !
  110. IF(lwp) THEN
  111. WRITE(numout,*) 'DATE',adatrj
  112. DO jpn = 1, jpnij
  113. IF( iperproc(jpn) /= 0 ) THEN
  114. WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iperproc(jpn), 'trajectories.'
  115. ENDIF
  116. END DO
  117. ENDIF
  118. ENDIF
  119. ENDIF
  120. END SUBROUTINE flo_rst
  121. # else
  122. !!----------------------------------------------------------------------
  123. !! Default option Empty module
  124. !!----------------------------------------------------------------------
  125. CONTAINS
  126. SUBROUTINE flo_rst ! Empty routine
  127. END SUBROUTINE flo_rst
  128. #endif
  129. !!=======================================================================
  130. END MODULE florst