- Timestamp:
- 2011-03-01T20:04:06+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r2633 r2636 18 18 !! 3.2 ! 2009 (R. Benshila) SHMEM suppression, north fold in lbc_nfd 19 19 !! 3.2 ! 2009 (O. Marti) add mpp_ini_znl 20 !! 4.0 ! 2011 (G. Madec) move ctl_ routines from in_out_manager 21 !!---------------------------------------------------------------------- 22 23 !!---------------------------------------------------------------------- 24 !! ctl_stop : update momentum and tracer Kz from a tke scheme 25 !! ctl_warn : initialization, namelist read, and parameters control 26 !! ctl_opn : Open file and check if required file is available. 27 !! get_unit : give the index of an unused logical unit 20 28 !!---------------------------------------------------------------------- 21 29 #if defined key_mpp_mpi … … 44 52 !! mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo 45 53 !!---------------------------------------------------------------------- 46 !! History : OPA ! 1994 (M. Guyon, J. Escobar, M. Imbard) Original code47 !! ! 1997 (A.M. Treguier) SHMEM additions48 !! ! 1998 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI49 !! NEMO 1.0 ! 2003 (J.-M. Molines, G. Madec) F90, free form50 !! ! 2004 (R. Bourdalle Badie) isend option in mpi51 !! ! 2005 (G. Madec, S. Masson) npolj=5,6 F-point & ice cases52 !! ! 2005 (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort53 !! ! 2009 (R. Benshila) SHMEM suppression, north fold in lbc_nfd54 !!----------------------------------------------------------------------55 54 USE dom_oce ! ocean space and time domain 56 55 USE lbcnfd ! north fold treatment 56 USE in_out_manager ! I/O manager 57 57 58 58 IMPLICIT NONE 59 59 PRIVATE 60 60 61 PUBLIC ctl_stop, ctl_warn, get_unit, ctl_opn 61 62 PUBLIC mynode, mppstop, mppsync, mpp_comm_free 62 63 PUBLIC mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e … … 116 117 # endif 117 118 118 CHARACTER(lc) :: cform_err = "(/,' ===>>> : E R R O R', /,' ===========',/)" !:119 CHARACTER(lc) :: cform_war = "(/,' ===>>> : W A R N I N G', /,' ===============',/)" !:120 121 119 ! variables used in case of sea-ice 122 120 INTEGER, PUBLIC :: ncomm_ice !: communicator made by the processors with sea-ice … … 2468 2466 !! Default case: Dummy module share memory computing 2469 2467 !!---------------------------------------------------------------------- 2468 USE in_out_manager 2470 2469 2471 2470 INTERFACE mpp_sum … … 2488 2487 END INTERFACE 2489 2488 2490 2491 2489 LOGICAL, PUBLIC, PARAMETER :: lk_mpp = .FALSE. !: mpp flag 2492 2490 INTEGER :: ncomm_ice 2493 2491 !!---------------------------------------------------------------------- 2494 2492 CONTAINS 2495 2493 … … 2666 2664 END SUBROUTINE mpp_comm_free 2667 2665 #endif 2666 2667 !!---------------------------------------------------------------------- 2668 !! All cases: ctl_stop, ctl_warn, get_unit, ctl_opn routines 2669 !!---------------------------------------------------------------------- 2670 2671 SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5 , & 2672 & cd6, cd7, cd8, cd9, cd10 ) 2673 !!---------------------------------------------------------------------- 2674 !! *** ROUTINE stop_opa *** 2675 !! 2676 !! ** Purpose : print in ocean.outpput file a error message and 2677 !! increment the error number (nstop) by one. 2678 !!---------------------------------------------------------------------- 2679 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd1, cd2, cd3, cd4, cd5 2680 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd6, cd7, cd8, cd9, cd10 2681 !!---------------------------------------------------------------------- 2682 ! 2683 nstop = nstop + 1 2684 IF(lwp) THEN 2685 WRITE(numout,cform_err) 2686 IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1 2687 IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2 2688 IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3 2689 IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4 2690 IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5 2691 IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6 2692 IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7 2693 IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8 2694 IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9 2695 IF( PRESENT(cd10) ) WRITE(numout,*) cd10 2696 ENDIF 2697 CALL FLUSH(numout ) 2698 IF( numstp /= -1 ) CALL FLUSH(numstp ) 2699 IF( numsol /= -1 ) CALL FLUSH(numsol ) 2700 IF( numevo_ice /= -1 ) CALL FLUSH(numevo_ice) 2701 ! 2702 IF( cd1 == 'STOP' ) THEN 2703 IF(lwp) WRITE(numout,*) 'huge E-R-R-O-R : immediate stop' 2704 CALL mppstop() 2705 ENDIF 2706 ! 2707 END SUBROUTINE ctl_stop 2708 2709 2710 SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5, & 2711 & cd6, cd7, cd8, cd9, cd10 ) 2712 !!---------------------------------------------------------------------- 2713 !! *** ROUTINE stop_warn *** 2714 !! 2715 !! ** Purpose : print in ocean.outpput file a error message and 2716 !! increment the warning number (nwarn) by one. 2717 !!---------------------------------------------------------------------- 2718 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd1, cd2, cd3, cd4, cd5 2719 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd6, cd7, cd8, cd9, cd10 2720 !!---------------------------------------------------------------------- 2721 ! 2722 nwarn = nwarn + 1 2723 IF(lwp) THEN 2724 WRITE(numout,cform_war) 2725 IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1 2726 IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2 2727 IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3 2728 IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4 2729 IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5 2730 IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6 2731 IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7 2732 IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8 2733 IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9 2734 IF( PRESENT(cd10) ) WRITE(numout,*) cd10 2735 ENDIF 2736 CALL FLUSH(numout) 2737 ! 2738 END SUBROUTINE ctl_warn 2739 2740 2741 SUBROUTINE ctl_opn( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea ) 2742 !!---------------------------------------------------------------------- 2743 !! *** ROUTINE ctl_opn *** 2744 !! 2745 !! ** Purpose : Open file and check if required file is available. 2746 !! 2747 !! ** Method : Fortan open 2748 !!---------------------------------------------------------------------- 2749 INTEGER , INTENT( out) :: knum ! logical unit to open 2750 CHARACTER(len=*) , INTENT(in ) :: cdfile ! file name to open 2751 CHARACTER(len=*) , INTENT(in ) :: cdstat ! disposition specifier 2752 CHARACTER(len=*) , INTENT(in ) :: cdform ! formatting specifier 2753 CHARACTER(len=*) , INTENT(in ) :: cdacce ! access specifier 2754 INTEGER , INTENT(in ) :: klengh ! record length 2755 INTEGER , INTENT(in ) :: kout ! number of logical units for write 2756 LOGICAL , INTENT(in ) :: ldwp ! boolean term for print 2757 INTEGER, OPTIONAL, INTENT(in ) :: karea ! proc number 2758 !! 2759 CHARACTER(len=80) :: clfile 2760 INTEGER :: iost 2761 !!---------------------------------------------------------------------- 2762 2763 ! adapt filename 2764 ! ---------------- 2765 clfile = TRIM(cdfile) 2766 IF( PRESENT( karea ) ) THEN 2767 IF( karea > 1 ) WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1 2768 ENDIF 2769 #if defined key_agrif 2770 IF( .NOT. Agrif_Root() ) clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile) 2771 knum=Agrif_Get_Unit() 2772 #else 2773 knum=get_unit() 2774 #endif 2775 2776 iost=0 2777 IF( cdacce(1:6) == 'DIRECT' ) THEN 2778 OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost ) 2779 ELSE 2780 OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat , ERR=100, IOSTAT=iost ) 2781 ENDIF 2782 IF( iost == 0 ) THEN 2783 IF(ldwp) THEN 2784 WRITE(kout,*) ' file : ', clfile,' open ok' 2785 WRITE(kout,*) ' unit = ', knum 2786 WRITE(kout,*) ' status = ', cdstat 2787 WRITE(kout,*) ' form = ', cdform 2788 WRITE(kout,*) ' access = ', cdacce 2789 WRITE(kout,*) 2790 ENDIF 2791 ENDIF 2792 100 CONTINUE 2793 IF( iost /= 0 ) THEN 2794 IF(ldwp) THEN 2795 WRITE(kout,*) 2796 WRITE(kout,*) ' ===>>>> : bad opening file: ', clfile 2797 WRITE(kout,*) ' ======= === ' 2798 WRITE(kout,*) ' unit = ', knum 2799 WRITE(kout,*) ' status = ', cdstat 2800 WRITE(kout,*) ' form = ', cdform 2801 WRITE(kout,*) ' access = ', cdacce 2802 WRITE(kout,*) ' iostat = ', iost 2803 WRITE(kout,*) ' we stop. verify the file ' 2804 WRITE(kout,*) 2805 ENDIF 2806 STOP 'ctl_opn bad opening' 2807 ENDIF 2808 2809 END SUBROUTINE ctl_opn 2810 2811 2812 INTEGER FUNCTION get_unit() 2813 !!---------------------------------------------------------------------- 2814 !! *** FUNCTION get_unit *** 2815 !! 2816 !! ** Purpose : return the index of an unused logical unit 2817 !!---------------------------------------------------------------------- 2818 LOGICAL :: llopn 2819 !!---------------------------------------------------------------------- 2820 ! 2821 get_unit = 15 ! choose a unit that is big enough then it is not already used in NEMO 2822 llopn = .TRUE. 2823 DO WHILE( (get_unit < 998) .AND. llopn ) 2824 get_unit = get_unit + 1 2825 INQUIRE( unit = get_unit, opened = llopn ) 2826 END DO 2827 IF( (get_unit == 999) .AND. llopn ) THEN 2828 CALL ctl_stop( 'get_unit: All logical units until 999 are used...' ) 2829 get_unit = -1 2830 ENDIF 2831 ! 2832 END FUNCTION get_unit 2833 2668 2834 !!---------------------------------------------------------------------- 2669 2835 END MODULE lib_mpp
Note: See TracChangeset
for help on using the changeset viewer.
